获取多个对象的累计长度之和

flyfox1047

命令bomlengths
获取多个对象的累计长度之和

1. (defun dxf (n ed) (cdr (assoc n ed)))
   
2. 
   
3. (defun bom-code (ssfilter        /       errexit undox   restore
   
4.                  *error* olderr  oldcmdecho      %l      %t
   
5.                  sset    %i      en      ed      p1      p2
   
6.                  ot      a1      a2      r
   
7.                 )
   
8.   (defun errexit (s)
   
9.     (princ)
   
10.     (restore)
    
11.   )
    
12. 
    
13.   (defun undox ()
    
14.     (command "._undo" "_E")
    
15.     (setvar "cmdecho" oldcmdecho)
    
16.     (setq *error* olderr)
    
17.     (princ)
    
18.   )
    
19. 
    
20.   (setq olderr  *error*
    
21.         restore undox
    
22.         *error* errexit
    
23.   )
    
24.   (setq oldcmdecho (getvar "cmdecho"))
    
25.   (setvar "cmdecho" 0)
    
26.   (command "._UNDO" "_BE")
    
27.   (setq %i 0
    
28.         %t 0
    
29.   )
    
30.   (vl-load-com)
    
31.   (setq sset (ssget ssfilter))
    
32.   (if sset
    
33.     (progn
    
34.       (princ "\nLengths:")
    
35.       (repeat (sslength sset)
    
36.   (setq en (ssname sset %i))
    
37.   (setq ed (entget en))
    
38.   (setq ot (dxf 0 ed))
    
39.   (setq curve (vlax-ename->vla-object en))
    
40.   (if (vl-catch-all-error-p
    
41.         (setq len  (vl-catch-all-apply
    
42.         'vlax-curve-getDistAtParam
    
43.         (list  curve
    
44.         (vl-catch-all-apply
    
45.           'vlax-curve-getEndParam
    
46.           (list curve)
    
47.         )
    
48.         )
    
49.       )
    
50.         )
    
51.       )
    
52.     nil
    
53.     len
    
54.   )
    
55.   (setq %l len)
    
56. 
    
57.   (setq %i (1+ %i)
    
58.         %t (+ %l %t)
    
59.   )
    
60.   (terpri)
    
61.   ;(princ %l )
    
62.   (princ (rtos %l (getvar "lunits")(getvar "luprec")))
    
63.       )
    
64.       (princ "\nTotal = ")
    
65.       ;(princ %t)
    
66.       (princ (rtos %t (getvar "lunits")(getvar "luprec")))
    
67.       (textpage)
    
68.     )
    
69.   )
    
70.   (setq sset nil)
    
71.   (restore)
    
72. )
    
73. 
    
74. (defun bom-code-old (ssfilter        /       errexit undox   restore
    
75.                  *error* olderr  oldcmdecho      %l      %t
    
76.                  sset    %i      en      ed      p1      p2
    
77.                  ot      a1      a2      r
    
78.                 )
    
79.   (defun errexit (s)
    
80.     (princ)
    
81.     (restore)
    
82.   )
    
83. 
    
84.   (defun undox ()
    
85.     (command "._undo" "_E")
    
86.     (setvar "cmdecho" oldcmdecho)
    
87.     (setq *error* olderr)
    
88.     (princ)
    
89.   )
    
90. 
    
91.   (setq olderr  *error*
    
92.         restore undox
    
93.         *error* errexit
    
94.   )
    
95.   (setq oldcmdecho (getvar "cmdecho"))
    
96.   (setvar "cmdecho" 0)
    
97.   (command "._UNDO" "_BE")
    
98.   (setq %i 0
    
99.         %t 0
    
100.   )
     
101.   (setq sset (ssget ssfilter))
     
102.   (if sset
     
103.     (progn
     
104.       (princ "\nLengths:")
     
105.       (repeat (sslength sset)
     
106.         (setq en (ssname sset %i))
     
107.         (setq ed (entget en))
     
108.         (setq ot (dxf 0 ed))
     
109.         (cond
     
110.           ((= ot "LINE")
     
111.            (setq p1 (dxf 10 ed)
     
112.                  p2 (dxf 11 ed)
     
113.                  %l (distance p1 p2)
     
114.            )
     
115.           )
     
116.           ((= ot "ARC")
     
117.            (setq a1 (dxf 50 ed)
     
118.                  a2 (dxf 51 ed)
     
119.                  r  (dxf 40 ed)
     
120.                  %l (* r (abs (- a2 a1)))
     
121.            )
     
122.           )
     
123.           (t
     
124.            (command "._area" "_obj" en)
     
125.            (setq %l (getvar "perimeter"))
     
126. 
     
127.           )
     
128.         )
     
129.         (setq %i (1+ %i)
     
130.               %t (+ %l %t)
     
131.         )
     
132.         (terpri)
     
133.         (princ %l)
     
134.       )
     
135.       (princ "\nTotal = ")
     
136.       (princ %t)
     
137.       (textpage)
     
138.     )
     
139.   )
     
140.   (setq sset nil)
     
141.   (restore)
     
142. )
     
143. 
     
144. (defun c:bomlengths ()
     
145.   (initget "Lines Arcs Polylines Splines ALL")
     
146.   (setq ans (getkword
     
147.               "Enter an option [Lines/Arcs/Polylines/Splines] : "
     
148.             )
     
149.   )
     
150.   (cond
     
151.     ((= ans "Lines") (c:bom_lines))
     
152.     ((= ans "Arcs") (c:bom_arcs))
     
153.     ((= ans "Polylines") (c:bom_polylines))
     
154.     ((= ans "Splines") (c:bom_splines))
     
155.     (t
     
156.      (bom-code '((-4 . "<OR")
     
157.                  (0 . "LINE")
     
158.                  (0 . "ARC")
     
159.                  (0 . "POLYLINE")
     
160.                  (0 . "LWPOLYLINE")
     
161.                  (0 . "SPLINE")
     
162.                  (-4 . "OR>")
     
163.                 )
     
164.      )
     
165.     )
     
166.   )
     
167.   (princ)
     
168. )
     
169. 
     
170. (defun c:bom_lines ()
     
171.   (bom-code '((0 . "LINE")))
     
172.   (princ)
     
173. )
     
174. 
     
175. (defun c:bom_arcs ()
     
176.   (bom-code '((0 . "ARC")))
     
177.   (princ)
     
178. )
     
179. 
     
180. (defun c:bom_polylines ()
     
181.   (bom-code '((-4 . "<OR")
     
182.               (0 . "POLYLINE")
     
183.               (0 . "LWPOLYLINE")
     
184.               (-4 . "OR>")
     
185.              )
     
186.   )
     
187.   (princ)
     
188. )
     
189. 
     
190. (defun c:bom_splines ()
     
191.   (bom-code '((0 . "SPLINE")))
     
192.   (princ)
     
193. )

(defun dxf (n ed) (cdr (assoc n ed)))<br /> <br /> (defun bom-code (ssfilter        /       errexit undox   restore<br />                  *error* olderr  oldcmdecho      %l      %t<br />                  sset    %i      en      ed      p1      p2<br />                  ot      a1      a2      r<br />                 )<br />   (defun errexit (s)<br />     (princ)<br />     (restore)<br />   )<br /> <br />   (defun undox ()<br />     (command "._undo" "_E")<br />     (setvar "cmdecho" oldcmdecho)<br />     (setq *error* olderr)<br />     (princ)<br />   )<br /> <br />   (setq olderr  *error*<br />         restore undox<br />         *error* errexit<br />   )<br />   (setq oldcmdecho (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (command "._UNDO" "_BE")<br />   (setq %i 0<br />         %t 0<br />   )<br />   (vl-load-com)<br />   (setq sset (ssget ssfilter))<br />   (if sset<br />     (progn<br />       (princ "\nLengths:")<br />       (repeat (sslength sset)<br />   (setq en (ssname sset %i))<br />   (setq ed (entget en))<br />   (setq ot (dxf 0 ed))<br />   (setq curve (vlax-ename->vla-object en))<br />   (if (vl-catch-all-error-p<br />         (setq len  (vl-catch-all-apply<br />         'vlax-curve-getDistAtParam<br />         (list  curve<br />         (vl-catch-all-apply<br />           'vlax-curve-getEndParam<br />           (list curve)<br />         )<br />         )<br />       )<br />         )<br />       )<br />     nil<br />     len<br />   )<br />   (setq %l len)<br /> <br />   (setq %i (1+ %i)<br />         %t (+ %l %t)<br />   )<br />   (terpri)<br />   ;(princ %l )<br />   (princ (rtos %l (getvar "lunits")(getvar "luprec")))<br />       )<br />       (princ "\nTotal = ")<br />       ;(princ %t)<br />       (princ (rtos %t (getvar "lunits")(getvar "luprec")))<br />       (textpage)<br />     )<br />   )<br />   (setq sset nil)<br />   (restore)<br /> )<br /> <br /> (defun bom-code-old (ssfilter        /       errexit undox   restore<br />                  *error* olderr  oldcmdecho      %l      %t<br />                  sset    %i      en      ed      p1      p2<br />                  ot      a1      a2      r<br />                 )<br />   (defun errexit (s)<br />     (princ)<br />     (restore)<br />   )<br /> <br />   (defun undox ()<br />     (command "._undo" "_E")<br />     (setvar "cmdecho" oldcmdecho)<br />     (setq *error* olderr)<br />     (princ)<br />   )<br /> <br />   (setq olderr  *error*<br />         restore undox<br />         *error* errexit<br />   )<br />   (setq oldcmdecho (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (command "._UNDO" "_BE")<br />   (setq %i 0<br />         %t 0<br />   )<br />   (setq sset (ssget ssfilter))<br />   (if sset<br />     (progn<br />       (princ "\nLengths:")<br />       (repeat (sslength sset)<br />         (setq en (ssname sset %i))<br />         (setq ed (entget en))<br />         (setq ot (dxf 0 ed))<br />         (cond<br />           ((= ot "LINE")<br />            (setq p1 (dxf 10 ed)<br />                  p2 (dxf 11 ed)<br />                  %l (distance p1 p2)<br />            )<br />           )<br />           ((= ot "ARC")<br />            (setq a1 (dxf 50 ed)<br />                  a2 (dxf 51 ed)<br />                  r  (dxf 40 ed)<br />                  %l (* r (abs (- a2 a1)))<br />            )<br />           )<br />           (t<br />            (command "._area" "_obj" en)<br />            (setq %l (getvar "perimeter"))<br /> <br />           )<br />         )<br />         (setq %i (1+ %i)<br />               %t (+ %l %t)<br />         )<br />         (terpri)<br />         (princ %l)<br />       )<br />       (princ "\nTotal = ")<br />       (princ %t)<br />       (textpage)<br />     )<br />   )<br />   (setq sset nil)<br />   (restore)<br /> )<br /> <br /> (defun c:bomlengths ()<br />   (initget "Lines Arcs Polylines Splines ALL")<br />   (setq ans (getkword<br />               "Enter an option [Lines/Arcs/Polylines/Splines] : "<br />             )<br />   )<br />   (cond<br />     ((= ans "Lines") (c:bom_lines))<br />     ((= ans "Arcs") (c:bom_arcs))<br />     ((= ans "Polylines") (c:bom_polylines))<br />     ((= ans "Splines") (c:bom_splines))<br />     (t<br />      (bom-code '((-4 . "<OR")<br />                  (0 . "LINE")<br />                  (0 . "ARC")<br />                  (0 . "POLYLINE")<br />                  (0 . "LWPOLYLINE")<br />                  (0 . "SPLINE")<br />                  (-4 . "OR>")<br />                 )<br />      )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> (defun c:bom_lines ()<br />   (bom-code '((0 . "LINE")))<br />   (princ)<br /> )<br /> <br /> (defun c:bom_arcs ()<br />   (bom-code '((0 . "ARC")))<br />   (princ)<br /> )<br /> <br /> (defun c:bom_polylines ()<br />   (bom-code '((-4 . "<OR")<br />               (0 . "POLYLINE")<br />               (0 . "LWPOLYLINE")<br />               (-4 . "OR>")<br />              )<br />   )<br />   (princ)<br /> )<br /> <br /> (defun c:bom_splines ()<br />   (bom-code '((0 . "SPLINE")))<br />   (princ)<br /> )

434939575

这么多子函数学习了！

l18c19

加载后，出现：未知命令“BOMLENGTHS”。按 F1 查看帮助。

yoyoho

感谢 flyfox1047 分享!

yiqisese

  感谢分享!    感谢分享!