[编程交流] 分组线的长度

(defun tlines ()
 (setq lbeg (cdr (assoc '10 ent)))
 (setq lend (cdr (assoc '11 ent)))
 (setq llen (distance lbeg lend))
 (setq tlen (+ tlen llen))
 (ssdel sn ss1)
)
(defun tarcs ()
 (setq cen (cdr (assoc '10 ent)))
 (setq rad (cdr (assoc '40 ent)))
 (setq dia (* rad 2.0))
 (setq circ (* (* rad pi) 2.0))
 (setq sang (cdr (assoc '50 ent)))
 (setq eang (cdr (assoc '51 ent)))
 (if (< eang sang)
   (setq eang (+ eang (* pi 2.0)))
 )
 (setq tang (- eang sang))
 (setq tang2 (* (/ tang pi) 180.0))
 (setq circ2 (/ tang2 360.0))
 (setq alen (* circ2 circ))
 (setq tlen (+ tlen alen))
 (princ)
 (ssdel sn ss1)
)
(defun tplines ()
 (command "area" "e" sn)
 (setq tlen (+ tlen (getvar "perimeter")))
 (ssdel sn ss1)
)
(defun tsplines        ()
 (command "area" "e" sn)
 (setq tlen (+ tlen (getvar "perimeter")))
 (ssdel sn ss1)
)
(DEFUN C:TOTLEN        (/ tlen ss1 sn sn2 et)
 (setq cmdecho (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq tlen 0)
 (prompt
   "\nSelect only the entities you want for the total length:"
 )
 (setq ss1 (ssget))
 (while (> (sslength ss1) 0)
   (setq sn (ssname ss1 0))
   (setq ent (entget sn))
   (setq et (cdr (assoc '0 ent)))
   (cond
     ((= et "LINE") (tlines))
     ((= et "ARC") (tarcs))
     ((= et "LWPOLYLINE") (tplines))
     ((= et "POLYLINE") (tplines))
     ((= et "SPLINE") (tsplines))
     ((or
 (/= et "LINE")
 (/= et "ARC")
 (/= et "LWPOLYLINE")
 (/= et "POLYLINE")
 (/= et "SPLINE")
      )
      (ssdel sn ss1)
     )
   )
 )
 (alert
   (strcat
     "\nThe total length of selected rows, polylines and arcs is:"
     (rtos tlen 2 2)
   )
 )
 (setvar "cmdecho" cmdecho)
 (prompt "\nAplicativo de terceiros!! ")
 (princ)
)

(vl-load-com)
(defun c:gsum        (/ l len )
 (if  (vlax-for x (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))
     (setq len 0.
           l   (cons (list "Group "
                           (vla-get-Name x)
                           " Length = "
                           (vlax-for x x
                             (if (wcmatch (strcase (vla-get-ObjectName x)) "*BARC,*BLINE")
                               (setq len (+ len (vlax-curve-getdistatparam x (vlax-curve-getendparam x))))
                               )
                             (rtos len 2)
                             )
                           )
                     l
                     )
           )
     )
   
   (foreach x l (terpri) (princ (apply 'strcat x)))
   (alert "\nOops! No group found?")
   
  )
 (textscr)
 (princ)
 )