;|===========================================================================|
| Seçilen Line, Polyline, Lwpolyline, Spline, Arc veya Circle objelerinin   |
| uygun yerine Mahal, Malzeme, Poz Numarası, Çap ve Boy Atrribute'lerini    |
| içeren "ebL" isimli bLock insert edilir.                                  |
| Hazırlayan: M. Şahin Güvercin  23.11.2012  www.autocadokulu.com           |
|___________________________________________________________________________|;
(defun cRtbLk ()
  (entmake (list '(0 . "BLOCK") '(100 . "AcDbEntity") '(100 . "AcDbBlockBegin")
    '(70 . 2) '(10 0.0 0.0 0.0) '(2 . "EbL") '(1 . "EbL")))
  (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(62 . 0)
    '(100 . "AcDbCircle") (cons 10 (mapcar '(lambda (p) (* p TsZ))
    '(-2.49912 3.0 0.0))) (cons 40 (* TsZ 1.65))))
  (entmake (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(62 . 0)
    '(100 . "AcDbText") (cons 10 (mapcar '(lambda (p) (* p TsZ))
    '(-3.935 2.49966 0.0))) (cons 40 TsZ) '(1 . "1") '(50 . 0.0) '(72 . 4)
    (cons 11 (mapcar '(lambda (p) (* p TsZ)) '(-2.49912 3.0 0.0)))
    '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Poz:") '(2 . "POZ")
    '(70 . 0) '(280 . 1)))
  (entmake (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(62 . 0)
    '(100 . "AcDbText") (cons 10 (mapcar '(lambda (p) (* p TsZ))
    '(0.0 3.0 0.0))) (cons 40 TsZ) '(1 . "Mahal") '(50 . 0.0) '(72 . 0)
    (cons 11 (mapcar '(lambda (p) (* p TsZ)) '(0.0 0.0 0.0)))
    '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Mahal:")
    '(2 . "MAHAL") '(70 . 0) '(280 . 1)))
  (entmake (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(62 . 0)
    '(100 . "AcDbText") (cons 10 (mapcar '(lambda (p) (* p TsZ))
    '(0.0 1.5 0.0))) (cons 40 TsZ) '(1 . "Malzeme") '(50 . 0.0) '(72 . 0)
    (cons 11 (mapcar '(lambda (p) (* p TsZ)) '(0.0 0.0 0.0)))
    '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Malzeme:")
    '(2 . "MALZEME") '(70 . 0) '(280 . 1)))
  (entmake (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(62 . 0)
    '(100 . "AcDbText") (cons 10 (mapcar '(lambda (p) (* p TsZ))
    '(0.0 0.0 0.0))) (cons 40 TsZ) '(1 . "0.00") '(50 . 0.0) '(72 . 0)
    (cons 11 (mapcar '(lambda (p) (* p TsZ)) '(0.0 0.0 0.0)))
    '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Boy: ") '(2 . "BOY")
    '(70 . 0) '(280 . 1)))
  (entmake (list '(0 . "ATTDEF") '(100 . "AcDbEntity") '(62 . 0)
    '(100 . "AcDbText") (cons 10 (mapcar '(lambda (p) (* p TsZ))
    '(-3.87244 0.0 0.0))) (cons 40 TsZ) '(1 . "1"") '(50 . 0.0) '(72 . 2)
    (cons 11 (mapcar '(lambda (p) (* p TsZ)) '(-1.0 0.0 0.0)))
    '(100 . "AcDbAttributeDefinition") '(280 . 0) '(3 . "Cap: ") '(2 . "CAP")
    '(70 . 0) '(280 . 1)))
  (entmake (list '(0 . "ENDBLK")))
)
;|___________________________________________________________________________|;
(defun crTdcL (aLddLg / f dcLf)
  (setq f (open aLddLg "w"))
  (foreach dcLf
'("//------------------=={ AlddLg.dcl Dialog Definition }==------------------//"
  "//              Author: M. Sahin Guvercin, Copyright © 2012              //"
  "//                        www.autocadokulu.com                           //"
  "//-----------------------------------------------------------------------//"
  "aLd:dialog{"
  "label="**** Boru Metrajı ****";"
  ": boxed_column{"
  ": edit_box{label="Ondalık Basamak Sayısı:";"
  "key="dpL";edit_width=25;}"
  ": edit_box{label="Başlangıç Poz Numarası:";"
  "key="Poz";edit_width=25;}"
  ": edit_box{alignment=right;label="                            Mahal: ";"
  "key="Mah";edit_width=25;}"
  ": edit_box{alignment=centered;label="                       Malzeme:";"
  "key="MaL";edit_width=25;}"
  ":edit_box{alignment=centered;label="                               Çap:";"
  "key="Cap";edit_width=25;}"
  "spacer;spacer;}"
  ": boxed_row{: text{key="CpR";value="
  ""          Hazırlayan: © M.Şahin Güvercin - www.autocadokulu.com""
  ";}}ok_cancel;}")
  (write-line dcLf f)) (close f)
)
;|___________________________________________________________________________|;
(defun rt (Rob Bas Ang / TmT)
  (setq Rob (vlax-ename->vla-object Rob) Tmt (vlax-tmatrix
    (list (list (cos Ang) (- (sin Ang)) 0 (- (car Bas)(- (* (car Bas)(cos ang))
      (* (cadr bas) (sin Ang))))) (list (sin Ang) (cos Ang) 0 (- (cadr Bas)
      (+ (* (car Bas) (sin Ang)) (* (cadr Bas) (cos Ang))))) (list 0 0 1 0)
      (list 0 0 0 1)))) (vla-transformby Rob Tmt)
)
;|___________________________________________________________________________|;
(defun sc (Mob Bas sc / TmT)
  (setq Mob (vlax-ename->vla-object Mob) TmT (vlax-tmatrix
    (list (list sc 0 0 (car Bas)) (list 0 sc 0 (cadr Bas))
          (list 0 0 sc (caddr Bas)) (list 0 0 0 1))))
  (vla-transformby Mob TmT)
)
;|___________________________________________________________________________|;
(defun mv (Mob fPt SPt / TmT)
  (setq Mob (vlax-ename->vla-object Mob) Tmt (vlax-tmatrix
    (list (list 1 0 0 (- (car sPt) (car fPt))) (list 0 1 0 (- (cadr sPt)
      (cadr fPt))) (list 0 0 1 (- (caddr sPt) (caddr fPt))) (list 0 0 0 1))))
  (vla-transformby Mob Tmt)
)
;|___________________________________________________________________________|;
(write-line "\n Hazırlayan: M. Şahin Güvercin - www.autocadokulu.com")
;|___________________________________________________________________________|;
(defun c:aLd (/ *error* bLkY ebLd MhLAtr MLzAtr PozAtr CapAtr BoyAtr PvT bLck
              PzLr dcL_id waht_next n Czg Boy BiP aCi aC0 aC1)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (defun *error* (er) (princ er) (princ em) (command "_.undo" "e"))
  (setq em  " M. Şahin Güvercin - www.autocadokulu.com"
        TsZ (getvar "DimTxt") scL (getvar "DimScaLe") TxH (* TsZ scL))
  (setq aLddLg (strcat (substr (findfile "acad.exe") 1 (- (strlen (findfile
                                          "acad.exe")) 8)) "Support\\aLd.dcL"))
  (if (not (findfile aLddLg)) (CrTdcL aLddLg))
  (if (not (tblsearch "bLock" "EbL")) (crTbLk))
  (setq bLkY (tblobjname "bLock" "EbL") ebLd (entget bLkY) MhLAtr nil
        MLzAtr nil PozAtr nil PozAtr nil CapAtr nil BoyAtr nil pzLr nil
        Poz nil) (if (not dpL) (setq dpL (getvar "Luprec")))
  (if (not Cap) (setq Cap ""))
  (if (not Mahal) (setq MahaL ""))
  (if (not MaLzeme) (setq MaLzeme ""))
  (while (setq bLkY (entnext bLkY)) (setq PvT (entget bLkY))
    (if (= (cdr (assoc 0 PvT)) "ATTDEF")
      (cond ((= (cdr (assoc 2 PvT)) "MAHAL")   (setq MhLAtr PvT))
            ((= (cdr (assoc 2 PvT)) "MALZEME") (setq MLzAtr PvT))
            ((= (cdr (assoc 2 PvT)) "POZ")     (setq PozAtr PvT))
            ((= (cdr (assoc 2 PvT)) "CAP")     (setq CapAtr PvT))
            ((= (cdr (assoc 2 PvT)) "BOY")     (setq BoyAtr PvT)))))
  (if (setq bLck (ssget "x" (list (cons 0 "INSERT") (cons 2 "ebL"))))
    (progn (setq n (sslength bLck))
      (while (not (minusp (setq n (1- n))))
        (setq PvT (ssname bLck n))
        (while (/= (cdr (assoc 0 (entget (setq PvT (entnext PvT))))) "SEQEND")
          (if (= (cdr (assoc 2 (entget PvT))) "POZ")
            (setq pzLr
                   (append pzLr (list (atoi (cdr (assoc 1 (entget PvT))))))))))
      (setq Poz (nth 0 (vl-sort pzLr '>))))) (if (not Poz) (setq Poz 0))
  (if (< (setq dcl_id (load_dialog aLddLg)) 0) (exit))
  (setq what_next -1)
  (while (< what_next 2)
    (if (not (new_dialog "aLd" dcl_id)) (exit))
    (set_tile "dpL" (itoa dpL)) (set_tile "Poz" (itoa (1+ Poz)))
    (set_tile "Mah" MahaL) (set_tile "MaL" MaLzeme) (set_tile "Cap" Cap)
    (action_tile "dpL" "(setq dpL (atoi (get_tile "dpL")))")
    (action_tile "Poz" "(setq Poz (1- (atoi (get_tile "Poz"))))")
    (action_tile "Mah" "(setq MahaL (get_tile "Mah"))")
    (action_tile "MaL" "(setq MaLzeme (get_tile "MaL"))")
    (action_tile "Cap" "(setq Cap (get_tile "Cap"))")
    (action_tile "accept" "(done_dialog 2)")
    (action_tile "cancel" "(done_dialog 3)")
    (setq what_next (start_dialog)))
  (if (= what_next 3) (exit))
  (princ "\r Ölçüsü yazılacak Obje(ler) seçiniz: ")
  (while (setq Czg (ssget ":s" (list (cons 0 "*line,arc,circle,ellipse"))))
    (setq n (sslength Czg))
    (while (not (minusp (setq n (1- n))))
      (setq Boy (vlax-curve-getDistAtParam (setq a (vlax-ename->vla-object
                                   (ssname Czg n))) (vlax-curve-getendparam a))
            BiP (vlax-curve-getPointAtDist a (/ Boy 2.0)))
      (setq kYs (cdr (assoc 0 (entget (ssname Czg n)))))
      (if (= (cdr (assoc 0 (entget (ssname Czg n)))) "LINE")
        (setq aCi (vlax-curve-getFirstDeriv a (/ Boy 2)))
        (setq aCi '(0.0 0.0 0.0)))
      (if (not (equal (car aCi) 0.0 1.0e-16))
        (setq aCi (atan (/ (cadr aCi) (car aCi)))) (setq aCi 0.0))
      (while (>= aCi pi) (setq aCi (- aCi pi)))
      (if (<= aCi (/ pi 2.0))
        (setq aC0 aCi aC1 (+ aCi (/ pi 2.0)))
        (setq aC0 (- aCi pi) aC1 (- aCi (/ pi 2.0))))
      (setq BiP (polar BiP aC1 (* (/ TsZ 2.0) scL)))
      (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") '(67 . 0)
        '(100 . "AcDbBlockReference") '(66 . 1) '(2 . "EbL") (assoc 10 ebLd)
        (cons 41 1) (cons 42 1) (cons 43 1) (cons 50 0) '(70 . 0) '(71 . 0)
        '(44 . 0.0)'(45 . 0.0)))
      (if MhLAtr (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity")
        (assoc 62 MhLAtr) '(100 . "AcDbText") (assoc 10 MhLAtr)
        (assoc 40 MhLAtr) (cons 1 MahaL) (assoc 50 MhLAtr) (assoc 41 MhLAtr)
        (assoc 51 MhLAtr) (assoc 71 MhLAtr) (assoc 72 MhLAtr) (assoc 11 MhLAtr)
        '(100 . "AcDbAttribute") '(280 . 0) (assoc 2 MhLAtr) (assoc 70 MhLAtr)
        (assoc 73 MhLAtr)(assoc 74 MhLAtr) '(280 . 1))))
      (if MLzAtr (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity")
        (assoc 62 MLzAtr) '(100 . "AcDbText") (assoc 10 MLzAtr)
        (assoc 40 MLzAtr)(cons 1 MaLzeme) (assoc 50 MLzAtr) (assoc 41 MLzAtr)
        (assoc 51 MLzAtr) (assoc 71 MLzAtr) (assoc 72 MLzAtr) (assoc 11 MLzAtr)
        '(100 . "AcDbAttribute") '(280 . 0) (assoc 2 MLzAtr) (assoc 70 MLzAtr)
        (assoc 73 MLzAtr)(assoc 74 MLzAtr) '(280 . 1))))
      (if PozAtr (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity")
        (assoc 62 PozAtr) '(100 . "AcDbText") (assoc 10 PozAtr)
        (assoc 40 PozAtr) (cons 1 (itoa (setq Poz (1+ Poz)))) (assoc 50 PozAtr)
        (assoc 41 PozAtr) (assoc 51 PozAtr) (assoc 71 PozAtr) (assoc 72 PozAtr)
        (assoc 11 PozAtr) '(100 . "AcDbAttribute") '(280 . 0) (assoc 2 PozAtr)
        (assoc 70 PozAtr) (assoc 73 PozAtr) (assoc 74 PozAtr) '(280 . 1))))
      (if CapAtr (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity")
        (assoc 62 CapAtr) '(100 . "AcDbText") (assoc 10 CapAtr)
        (assoc 40 CapAtr) (cons 1 Cap) (assoc 50 CapAtr) (assoc 41 CapAtr)
        (assoc 51 CapAtr)(assoc 71 CapAtr) (assoc 72 CapAtr) (assoc 11 CapAtr)
        '(100 . "AcDbAttribute") '(280 . 0) (assoc 2 CapAtr) (assoc 70 CapAtr)
        (assoc 73 CapAtr)(assoc 74 CapAtr) '(280 . 1))))
      (if BoyAtr (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity")
        (assoc 62 BoyAtr) '(100 . "AcDbText") (assoc 10 BoyAtr)
        (assoc 40 BoyAtr) (cons 1 (rtos Boy 2 dpL)) (assoc 50 BoyAtr)
        (assoc 41 BoyAtr) (assoc 51 BoyAtr) (assoc 71 BoyAtr) (assoc 72 BoyAtr)
        (assoc 11 BoyAtr) '(100 . "AcDbAttribute") '(280 . 0) (assoc 2 BoyAtr)
        (assoc 70 BoyAtr) (assoc 73 BoyAtr) (assoc 74 BoyAtr) '(280 . 1))))
      (entmake (list '(0 . "SEQEND") '(100 . "AcDbEntity")))
      (vlax-put-property
        (vlax-ename->vla-object (ssname Czg n)) 'Layer (getvar "CLayer"))
      (sc (entlast) (cdr (assoc 10 ebLd)) scL)
      (rt (entlast) (cdr (assoc 10 ebLd)) aC0)
      (mv (entlast) (cdr (assoc 10 ebLd)) BiP))
      (princ "\r Ölçüsü yazılacak Obje(ler) seçiniz: "))
  (command "_.undo" "e") (princ)
)