wimal 发表于 2022-7-5 15:08:26

分组线的长度

我有一组只包含直线和圆弧。我可以用lisp获得直线和圆弧的总长度吗。

JuniorNogueira 发表于 2022-7-5 15:25:15

试试这个：
 
(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)
)

hanhphuc 发表于 2022-7-5 15:39:30


(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)
)

wimal 发表于 2022-7-5 15:49:22

 
程序正在运行。但我需要先选择一个组，然后找到该组的总长度。

wimal 发表于 2022-7-5 16:01:31

 
谢谢，它工作得很好。

hanhphuc 发表于 2022-7-5 16:18:21

 
你这里的“组”是什么意思？如果它只是一个选择而不是“ACAD_组”？
 
然后快速脏VL
（vl load com）（定义c：总和（/l）（if（和（ssget’（（0。”线，弧“））；
页: [1]
查看完整版本: 分组线的长度