;|===========================================================================| 
 | Boru Metrajını yapmak için M. Şahin Güvercin tarafından hazırlanmıştır.   | 
 |                                  www.cizimokulu.com 12.05.2014            | 
 |===========================================================================|;
(defun C:BoMe(/ Boy Cap cp gbr Kbr KPNo kuk L MPo myerr Nk1 Nk2 olderr Rw YYuk)
  (defun myerr (errmsg)
    (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg)))
    (command "._undo" "_e")
    (mapcar 'vlax-release-object (list rn ExCLLs Sht1 Shts NwBook Books ExApp))
    (setq ExApp nil) (gc) (gc) (setq egbr gbr eKbr Kbr eYuk YYuk eKPN KPNo)
    (setq *error* olderr) (princ))
  (setq olderr *error* *error* myerr) (*push-error-using-command*)
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com) (setq cp "")
  (foreach ch '(77 46 32 83 97 104 105 110 32 71 252 118 101 114 99 105 110 32
    45 32) (setq cp (strcat cp (chr ch)))) (if (not egbr) (setq egbr "Cm"))
  (setq kuk (initget "Mm Cm mT \"\"")
        gbr (getkword (strcat "\nÇizim Birimi [Mm/Cm/mT] <" egbr "> :")))
  (if (not gbr) (setq gbr egbr)) (if (not eKbr) (setq eKbr "Mm"))
  (if (not eYuk) (setq eYuk (* (getvar "dimtxt") (getvar "dimscale"))))
  (setq kuk  (initget)
        YYuk (getreal (strcat "\nYazi yüksekligi <" (rtos eYuk) "> :")))
  (if (not YYuk) (setq YYuk eYuk)) (if (not eKPN) (setq eKPN 1))
  (setq KPNo (getint (strcat "\nPoz Numarası <" (itoa eKPN) "> :")))
  (if (not KPNo) (setq KPNo eKPN))
  (setq ExApp (vlax-get-or-create-object "Excel.Application") Rw 1)
  (if (setq NwBook (vlax-get-property ExApp "ActiveWorkbook"))
    (setq Books  (vlax-get-property ExApp "WorkBooks")
          Shts   (vlax-get-property NwBook "Sheets")
          Sht1   (vlax-invoke-method Shts "Add"))
    (setq Books  (vlax-get-property ExApp "WorkBooks")
          NwBook (vlax-invoke-method Books "Add")
          Shts   (vlax-get-property NwBook "Sheets")
          Sht1   (vlax-get-property Shts "Item" 1)))
  (setq ExCLLs (vlax-get-property Sht1 "Cells"))
  (vlax-put-property ExApp "UseSystemSeparators" :vlax-false)
  (vlax-put-property ExApp "DecimalSeparator" ".") 
  (vla-put-visible ExApp :vlax-true)
  (mapcar '(lambda (p1 p2)
             (vlax-put-property ExCLLs 'Item (nth 0 p1) (nth 1 p1) p2))
         '((1 1 1 1) (1 2 1 2) (1 3 1 3)) '("Poz No." "Çap" "Boy"))
  (vlax-put-property (vlax-get-property (vlax-get-property ExCLLs "Range"
        (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 1))
        (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 3)))
                       'CeLLs) 'HorizontalAlignment (vlax-make-variant -4108))
  (while (setq Nk1 (getpoint "\nBoru Başlangıç Noktasını seçiniz..."))
    (setq Nk2 (getpoint Nk1  "\n    Boru Bitiş Noktasını seçiniz...")
          Boy (distance Nk1 Nk2)
          MPo (mapcar '(lambda (n1 n2) (/ (+ n1 n2) 2.0)) Nk1 Nk2))
    (entmake (list (cons 0 "TEXT") (cons 10 MPo) (cons 40 YYuk) 
                   (cons 1 (itoa KPNo)) (cons 50 0) (cons 72 4) (cons 11 MPo)))
    (entmake (list (cons 0 "CIRCLE") (cons 10 MPo) (cons 40 (* 1.15 YYuk))))
    (princ "\nBoru Çap Yazısını seçiniz...")
    (while (not (setq Cap (ssget "+.:s" (list (cons 0 "*TEXT")))))
      (princ "\n Sectiginiz obje bir Text veya MText olmalıdır!"))
    (cond ((= gbr "Mm") (setq Boy (/ Boy 1000)))
          ((= gbr "Cm") (setq Boy (/ Boy 100)))
          ((= gbr "m") (setq Boy Boy))
          (T nil))
    (setq Rw (1+ Rw) Cap (cdr (assoc 1 (entget (ssname Cap 0)))))
    (if (vl-string-position 45 Cap)
      (setq Cap (substr Cap (+ 2 (vl-string-position 45 Cap)))))
    (mapcar '(lambda (p1 p2) (vlax-put-property ExCLLs 'Item rw p1 p2))
            '(1 2 3) (list (itoa KPNo) Cap (rtos Boy 2 2)))
    (princ (strcat "\n* Poz No:" (itoa KPNo) ", Çap:" Cap 
      ", Boy:" (rtos Boy 2 2))) (setq KPNo (1+ KPNo)))
  (setq Rw (1+ Rw) rn (vlax-get-property ExCLLs "Range" 
             (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 1))
             (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 3))))
  (vlax-put-property rn 'MergeCells :vlax-true)
  (vlax-put-property ExCLLs 'Item Rw 1 (foreach ch '(119 119 119 46 99 105 122
    105 109 111 107 117 108 117 46 99 111 109) (setq cp (strcat cp (chr ch)))))
  (vlax-put-property rn 'ShrinkToFit :vlax-true)
  (setq rn (vlax-get-property ExCLLs "Range" 
             (vlax-variant-value (vlax-get-property ExCLLs 'Item 1 1))
             (vlax-variant-value (vlax-get-property ExCLLs 'Item Rw 3))))
  (vlax-put-property (vlax-get-property rn 'Borders) 'color (vlax-make-variant "0.0"))
  (vlax-put-property (vlax-get-property rn 'Borders) 'LineStyle (vlax-make-variant "1"))
  (vlax-invoke-method (vlax-get-property rn 'Columns) 'AutoFit)
  (vlax-invoke-method (vlax-get-property rn 'Rows) 'AutoFit)
  (vlax-put-property ExApp "UseSystemSeparators" :vlax-true)
  (mapcar 'vlax-release-object (list rn ExCLLs Sht1 Shts NwBook Books ExApp))
  (setq ExApp nil) (gc) (gc) (setq egbr gbr eKbr Kbr eYuk YYuk eKPN KPNo)
  (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1))