;;; Line, Curve or Perimeter Length
;;; Developed by S.Chatchawal, schatchawal@gmail.com
(vl-load-com)
(defun c:Perimeter (/ e obj)
(setq e (select1 (list "AcDbArc" "AcDbCircle"
"AcDbEllipse" "AcDbLine"
"AcDbPolyline" "AcDbSpline"
)
"\nSelect line or curve: \n"
)
)
(setq obj (vlax-ename->vla-object e))
(princ (vla-get-ObjectName obj))
(princ " >> Line, Curve or Perimeter Length = ")
(cond
((vlax-property-available-p obj 'Length)
(princ (vla-get-Length obj))
)
((vlax-property-available-p obj 'ArcLength)
(princ (vla-get-ArcLength obj))
)
((vlax-property-available-p obj 'Circumference)
(princ (vla-get-Circumference obj))
)
(T (princ "<
)
(princ)
)
(defun select1 (objNameList msg / stop e obj)
(while (not stop)
(if (setq e (entsel msg))
(progn
(setq obj (vlax-ename->vla-object (setq e (car e))))
(if (member (vla-get-ObjectName obj) objNameList)
(setq stop T)
(progn
(princ "Not ")
(princ objNameList)
(princ "!!! Try again!!!")
)
)
)
(princ "\nNo object found!!!")
)
)
e
)
(defun c:sLength (/ s obj j L ssn m objName)
(princ
"\nFind sum length of Arc, Circle, Line and Polyline objects."
)
(if (setq s (ssget))
(progn
(setq j -1
L 0.0
ssn (sslength s)
m 0
)
(repeat ssn
(setq obj (vlax-ename->vla-object (ssname s (setq j (1+ j))))
)
(if (member (setq objName (vla-get-ObjectName obj))
(list "AcDbArc"
"AcDbCircle"
"AcDbLine"
"AcDbPolyline"
)
)
(progn
(setq m (1+ m))
(cond
((= "AcDbArc" objName)
(setq L (+ L (vla-get-ArcLength obj)))
)
((= "AcDbCircle" objName)
(setq L (+ L (vla-get-Circumference obj)))
)
((= "AcDbLine" objName)
(setq L (+ L (vla-get-Length obj)))
)
((= "AcDbPolyline" objName)
(setq L (+ L (vla-get-Length obj)))
)
)
)
)
) ;repeat
(princ "\nTotal length of ")
(princ m)
(princ " objects: ")
(princ L)
(princ " (from ")
(princ ssn)
(princ " selected objects)")
)
(princ "\nNo object found!!!")
)
(princ)
)
ไม่มีความคิดเห็น:
แสดงความคิดเห็น