;|---------------------------------------------------------------------------|
| Seçilen Line, Polyline, Lwpolyline, Circle ve Arc türü çizim nesnelerinin |
| (uzunluğunun) orta noktasına, orta noktadaki teğet eğimine uygun açıda,   |
| verilen ondalık basamak sayısında, çizilen ve yazdırılacak ölçü birimi    |
| oranlarında, ilgili nesneye Field ile bağlayarak uzunluklarını yazar.     |
| Önek ve Son ek kullanılabilir.                                            |
|                                        Mehmet Şahin Güvercin (ProhibiT)   |
|                                           13.10.2020 www.cizimokulu.com   |
|---------------------------------------------------------------------------|;
(defun c:uzy (/ Luf dp tx Lea Tra sTy scm Fob n PvT Pv1 nsn ins par aci uyz)
  (setvar "cmdecho" 0) (command "_.undo" "group") (vl-load-com)
  (if (= Lufo nil) (setq Lufo 1.0)) (if (= dpo nil) (setq dpo 0))
  (setq Luf (getreal (strcat "\nÇizilen/Yazılan oranı <" (rtos Lufo) ">:"))
        dp  (getint (strcat "\rOndalık basamak sayısı <" (itoa dpo) ">: ")))
  (if (= nil Luf) (setq Luf Lufo) (setq Lufo Luf))
  (if (= nil dp) (setq dp dpo) (setq dpo dp))
  (if (= txo nil) (setq txo (* (getvar "dimscale") (getvar "dimtxt"))))
  (if (not (setq tx (getreal (strcat "\n      Yazı Yüksekliği <" (rtos txo)
                                     "> :")))) (setq tx txo) (setq txo tx))
  (setq sTy (getvar "TextStyle"))
 
  (if (not Leo) (setq Leo "L=")) (if (not Tro) (setq Tro " cm"))
  (setq Lea (getstring T (strcat "\nUzunluk yazısı öneki (" Leo "): ")))
  (cond ((= Lea "") (setq Lea Leo)) ((= (strcase Lea) "X") (setq Lea "")))
  (setq Tra (getstring T (strcat "\nUzunluk yazısı soneki (" Tro "): ")))
  (cond ((= Tra "") (setq Tra Tro)) ((= (strcase Tra) "X") (setq Tra "")))
  (setq Leo Lea Tro Tra)
 
  (setq scm (ssget (list '(0 . "ARC,CIRCLE,LINE,*POLYLINE")))
Fob (ssadd) n (sslength scm))
  (while (>= (setq n (1- n)) 0)
    (setq PvT (ssname scm n) Pv1 (entget PvT) nsn (vlax-ename->vla-object PvT)
  ins (vlax-curve-getpointatparam nsn
(setq par (vlax-curve-getparamatdist nsn
    (/ (vlax-curve-getdistatparam nsn
(vlax-curve-getendparam nsn)) 2.0))))
  aci (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv nsn par))
  uyz (strcat "%<\\AcObjProp Object(%<\\_ObjId "
      (itoa (vlax-get-property nsn 'ObjectID)) ">%)."
      (cond ((= "CIRCLE" (cdr (assoc 0 Pv1))) "Circumference")
    ((= "ARC" (cdr (assoc 0 Pv1))) "ArcLength")
    ("Length"))
      " \\f "%lu2%pr" (itoa dp) "%ps[" Lea "," Tra
      "]%ct8[" (rtos Luf) "]">%"))
    (while (>= aci pi) (setq aci (- aci pi)))
    (if (> aci (/ pi 2.0)) (setq aci (- aci pi)) (setq aci (+ aci pi)))
    (while (>= aci pi) (setq aci (- aci pi)))
    (entmake (list (cons 0 "TEXT") (cons 7 sTy) (cons 10 ins) (cons 40 tx)
                   (cons 1 uyz) (cons 50 aci) (cons 72 4) (cons 11 ins)))
    (ssadd (entlast) Fob)) (command "_.UpdateFieLd" Fob "")
  (command "undo" "e") (prin1))