[求助]请问如何生成hatch的边界

dickfly

图上有一个没有边界的hatch...我想为他生成边界

用appendloop函数行吗?  pHat->appendloop(1,objIds) 我用这样的语句时候..net报错

请教一下,该怎么为一个没有边界的hatch生成边界..

谢谢

jaminth

2. ;;; HATCHB.LSP ver 2.0
3. ;;; Recreates hatch boundary by selecting a hatch
4. ;;; Boundary is created in current layer/color/linetype in WCS
5. ;;; By Jimmy Bergmark
6. ;;; Copyright (C) 1997-2003 JTB World, All Rights Reserved
7. ;;; Website: [url]www.jtbworld.com[/url]
8. ;;; E-mail: [email]info@jtbworld.com[/email]
9. ;;; 2000-02-12 - First release
10. ;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed
11. ;;;              Objects created joined to lwpolyline if possible
12. ;;;              Error-handling, undo of command
13. ;;;              Can handle PLINETYPE = 0,1,2
14. ;;; 2000-03-30 - Integrating hatchb and hatchb14
15. ;;;              Selection of many hatches
16. ;;;              Splines supported if closed.
17. ;;; 2001-04-02 - Fixed bug with entmake of line with no Z for r14
18. ;;; 2001-07-31 - Removed an irritating semicolon to enable polylines to be created.
19. ;;; 2001-10-04 - Changed mail and homepage so it's easy to find when new versions comes up.
20. ;;; 2003-02-06 - Minor fix
21. ;;; 2003-02-17 - Area returned if no islands is found since it's not consistant
22. ;;; 2003-05-19 - Fix to take PEDITACCEPT variable used in AutoCAD 2004 into account
23. ;;; Tested on AutoCAD r14, 2000, 2000i, 2002, 2004
24. ;;; should be working on older versions too.
25. (defun c:rebuild_hatch_border () (c:hb)) ; this line can be commented out if there is an existing command called hb
26. (defun c:hb (/     es    blay  ed1   ed2   loops1      bptf  part
27.              et    noe   plist ic    bul   nr    ang1  ang2  obj *ModelSpace* *PaperSpace*
28.              space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss lwp
29.              list->variantArray 3dPoint->2dPoint A2k ent i ss2
30.              knot-list controlpoint-list kn cn pos xv bot area hst
31.             )
32. (setq A2k (>= (substr (getvar "ACADVER") 1 2) "15"))
33. (if A2k
34.    (progn
35.      (defun list->variantArray (ptsList / arraySpace sArray)
36.        (setq arraySpace
37.           (vlax-make-safearray
38.         vlax-vbdouble
39.         (cons 0 (- (length ptsList) 1))
40.           )
41.        )
42.        (setq sArray (vlax-safearray-fill arraySpace ptsList))
43.        (vlax-make-variant sArray)
44.      )
45.      (defun areaOfObject (en / curve area)
46.        (if en
47.      (if A2k
48.        (progn
49.          (setq curve (vlax-ename->vla-object en))
50.          (if
51.            (vl-catch-all-error-p
52.          (setq
53.            area
54.             (vl-catch-all-apply 'vlax-curve-getArea (list curve))
55.          )
56.            )
57.         nil
58.         area
59.          )
60.        )
61.        (progn
62.          (command "._area" "_O" en)
63.          (getvar "area")
64.        )
65.      )
66.        )
67.      )
68.    )
69. )
70. (if A2k
71.   (defun 3dPoint->2dPoint (3dpt)
72.     (list (float (car 3dpt)) (float (cadr 3dpt)))
73.   )
74. )
75.   (defun errexit (s)
76.     (princ "\nError:  ")
77.     (princ s)
78.     (restore)
79.   )
80.   (defun undox ()
81.     (command "._ucs" "_p")
82.     (command "._undo" "_E")
83.     (setvar "cmdecho" oldcmdecho)
84.     (setq *error* olderr)
85.     (princ)
86.   )
87.   (setq olderr  *error*
88.         restore undox
89.         *error* errexit
90.   )
91.   (setq oldcmdecho (getvar "cmdecho"))
92.   (setvar "cmdecho" 0)
93.   (command "._UNDO" "_BE")
94.   (if A2k (progn
95.     (vl-load-com)
96.     (setq *ModelSpace* (vla-get-ModelSpace
97.                          (vla-get-ActiveDocument (vlax-get-acad-object))
98.                        )
99.           *PaperSpace* (vla-get-PaperSpace
100.                          (vla-get-ActiveDocument (vlax-get-acad-object))
101.                        )
102.     ))
103.   )
105. ; For testing purpose
106. ; (setq A2k nil)
107.    
108.   (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
109.    (progn
110.     (setq i 0)
111.     (setq area 0)
112.     (setq bMoreLoops nil)
113.     (while (setq ent (ssname ss2 i))
114.       (setq ed1 (entget ent))
115.       (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch not in WCS!"))
116.       (setq xv (cdr (assoc 210 ed1)))
117.       (command "._ucs" "_w")
118.       (setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)
119.       (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
120.         (setq space *ModelSpace*)
121.         (setq space *PaperSpace*)
122.       )
123.       (repeat loops1
124.         (setq ed1 (member (assoc 92 ed1) ed1))
125.         (setq bptf (cdr (car ed1))) ; boundary path type flag
126.         (setq ic (cdr (assoc 73 ed1))) ; is closed
127.         (setq noe (cdr (assoc 93 ed1))) ; number of edges
128.     (setq bot (cdr (assoc 92 ed1))) ; boundary type
129.     (setq hst (cdr (assoc 75 ed1))) ; hatch style
130.         (setq ed1 (member (assoc 72 ed1) ed1))
131.         (setq bul (cdr (car ed1))) ; bulge
132.         (setq plist nil)
133.         (setq blist nil)
134.         (cond
135.           ((> (boole 1 bptf 2) 0) ; polyline
136.            (repeat noe
137.              (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
138.              (setq plist (append plist (list (cdr (assoc 10 ed1)))))
139.              (setq blist (append blist
140.                                  (if (> bul 0)
141.                                    (list (cdr (assoc 42 ed1)))
142.                                    nil
143.                                  )
144.                          )
145.              )
146.            )
147.            (if A2k (progn
148.              (setq polypoints
149.                     (apply 'append
150.                            (mapcar '3dPoint->2dPoint plist)
151.                     )
152.              )
153.              (setq VLADataPts (list->variantArray polypoints))
154.              (setq obj (vla-addLightweightPolyline space VLADataPts))
155.              (setq nr 0)
156.              (repeat (length blist)
157.                (if (/= (nth nr blist) 0)
158.                  (vla-setBulge obj nr (nth nr blist))
159.                )
160.                (setq nr (1+ nr))
161.              )
162.              (if (= ic 1)
163.                (vla-put-closed obj T)
164.              )
165.             )
166.             (progn
167.               (if (= ic 1)
168.                 (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
169.                 (entmake '((0 . "POLYLINE") (66 . 1)))
170.               )
171.               (setq nr 0)
172.               (repeat (length plist)
173.                 (if (= bul 0)
174.                   (entmake (list (cons 0 "VERTEX")
175.                                  (cons 10 (nth nr plist))
176.                            )
177.                   )
178.                   (entmake (list (cons 0 "VERTEX")
179.                                  (cons 10 (nth nr plist))
180.                                  (cons 42 (nth nr blist))
181.                            )
182.                   )
183.                 )
184.                 (setq nr (1+ nr))
185.               )
186.               (entmake '((0 . "SEQEND")))
187.             )
188.            )
189.           )
190.           (t ; not polyline
191.            (setq lastent (entlast))
192.            (setq lwp T)
193.            (repeat noe
194.              (setq et (cdr (assoc 72 ed1)))
195.              (cond
196.                ((= et 1) ; line
197.                 (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
198.                 (if A2k
199.                   (vla-AddLine
200.                     space
201.                     (vlax-3d-point (cdr (assoc 10 ed1)))
202.                     (vlax-3d-point (cdr (assoc 11 ed1)))
203.                   )
204.                   (entmake
205.                     (list
206.                       (cons 0 "LINE")
207.                       (list 10 (cadr (assoc 10 ed1)) (caddr (assoc 10 ed1)) 0)
208.                       (list 11 (cadr (assoc 11 ed1)) (caddr (assoc 11 ed1)) 0)
209.             ;  (cons 210 xv)
210.                     )
211.                   )
212.                 )
213.                 (setq ed1 (cddr ed1))
214.                )
215.                ((= et 2) ; circular arc
216.                  (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
217.                  (setq ang1 (cdr (assoc 50 ed1)))
218.                  (setq ang2 (cdr (assoc 51 ed1)))
219.                  (setq cw (cdr (assoc 73 ed1)))
220.                  (if (equal ang2 6.28319 0.00001)
221.                    (progn
222.                      (if A2k
223.                        (vla-AddCircle
224.                          space
225.                          (vlax-3d-point (cdr (assoc 10 ed1)))
226.                          (cdr (assoc 40 ed1))
227.                        )
228.                        (entmake (list (cons 0 "CIRCLE")
229.                                       (assoc 10 ed1)
230.                                       (assoc 40 ed1)
231.                                 )
232.                        )
233.                      )
234.                      (setq lwp nil)
235.                    )
236.                    (if A2k
237.                      (vla-AddArc
238.                        space
239.                        (vlax-3d-point (cdr (assoc 10 ed1)))
240.                        (cdr (assoc 40 ed1))
241.                        (if (= cw 0)
242.                          (- 0 ang2)
243.                          ang1
244.                        )
245.                        (if (= cw 0)
246.                          (- 0 ang1)
247.                          ang2
248.                        )
249.                      )
250.                      (entmake (list (cons 0 "ARC")
251.                                     (assoc 10 ed1)
252.                                     (assoc 40 ed1)
253.                                     (cons 50
254.                                           (if (= cw 0)
255.                                             (- 0 ang2)
256.                                             ang1
257.                                           )
258.                                     )
259.                                     (cons 51
260.                                           (if (= cw 0)
261.                                             (- 0 ang1)
262.                                             ang2
263.                                           )
264.                                     )
265.                               )
266.                      )
267.                    )
268.                  )
269.                  (setq ed1 (cddddr ed1))
270.                )
271.                ((= et 3) ; elliptic arc
272.                 (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
273.                 (setq ang1 (cdr (assoc 50 ed1)))
274.                 (setq ang2 (cdr (assoc 51 ed1)))
275.                 (setq cw (cdr (assoc 73 ed1)))
276.                 (if A2k (progn
277.                   (setq obj (vla-AddEllipse
278.                               space
279.                               (vlax-3d-point (cdr (assoc 10 ed1)))
280.                               (vlax-3d-point (cdr (assoc 11 ed1)))
281.                               (cdr (assoc 40 ed1))
282.                             )
283.                   )
284.                   (vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
285.                   (vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
286.                  )
287.                  (princ "\nElliptic arc not supported!")
288.                 )
289.                 (setq lwp nil)
290.                )
291.                ((= et 4) ; spline
292.                 (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
293.                 (setq knot-list nil)
294.                 (setq controlpoint-list nil)
295.         (setq kn (cdr (assoc 95 ed1)))
296.                 (setq cn (cdr (assoc 96 ed1)))
297.                 (setq pos (vl-position (assoc 40 ed1) ed1))
298.                 (repeat kn
299.                   (setq knot-list (cons (cons 40 (cdr (nth pos ed1))) knot-list))
300.                   (setq pos (1+ pos))
301.                 )
302.                 (setq pos (vl-position (assoc 10 ed1) ed1))
303.                 (repeat cn
304.                   (setq controlpoint-list (cons (cons 10 (cdr (nth pos ed1))) controlpoint-list))
305.                   (setq pos (1+ pos))
306.                 )
307.                 (setq knot-list (reverse knot-list))
308.                 (setq controlpoint-list (reverse controlpoint-list))
309.                 (entmake (append
310.                        (list '(0 . "SPLINE"))
311.                                (list (cons 100 "AcDbEntity"))
312.                                (list (cons 100 "AcDbSpline"))
313.                                (list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74 ed1))) (* 4 (cdr (assoc 73 ed1))))))
314.                                (list (cons 71 (cdr (assoc 94 ed1))))
315.                                (list (cons 72 kn))
316.                                (list (cons 73 cn))
317.                                knot-list
318.                                controlpoint-list
319.                       )
320.                 )
321.         (setq ed1 (member (assoc 10 ed1) ed1))
322.                 (setq lwp nil)
323.                )
324.              ) ; end cond
325.            ) ; end repeat noe
326.            (if lwp (progn
327.              (setq en1 (entnext lastent))
328.              (setq ss (ssadd))
329.              (ssadd en1 ss)
330.              (while (setq en2 (entnext en1))
331.                (ssadd en2 ss)
332.                (setq en1 en2)
333.              )
334.          (if (= (getvar "peditaccept") 1)
335.                (command "_.pedit" (entlast) "_J" ss "" "")
336.            (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
337.          )
338.           ))
339.           ) ; end t
340.         ) ; end cond
341. ;    Tries to get the area on islands but it's not clear how to know if an island is filled or not
342. ;    and if it should be substracted or added to the total area.
343. ;    (if (or (= bot 0) (= (boole 1 bot 1) 1)) (setq area (+ area (areaOfObject (entlast)))))
344. ;    (if (and (/= hst 1) (/= bot 0) (= (boole 1 bot 1) 0)) (setq area (- area (areaOfObject (entlast)))))
345. ;    (princ "\n") (princ bot) (princ "\n") (princ hst) (princ "\n")
346. ;    (princ (areaOfObject (entlast)))
347.       ) ; end repeat loops1
348.       (if (= loops1 1) (setq area (+ area (areaOfObject (entlast)))) (setq bMoreLoops T))
349.       (setq i (1+ i))
350.     )
351.    )
352.   )
353.   (if (and area (not bMoreLoops)) (progn
354.     (princ "\nTotal Area = ")
355.     (princ area)
356.   ))
357.   (restore)
358.   (princ)
359. )

;;; HATCHB.LSP ver 2.0 ;;; Recreates hatch boundary by selecting a hatch ;;; Boundary is created in current layer/color/linetype in WCS ;;; By Jimmy Bergmark ;;; Copyright (C) 1997-2003 JTB World, All Rights Reserved ;;; Website: [url]www.jtbworld.com[/url] ;;; E-mail: [email]info@jtbworld.com[/email] ;;; 2000-02-12 - First release ;;; 2000-03-27 - Counterclockwise arc's and ellipse's fixed ;;;              Objects created joined to lwpolyline if possible ;;;              Error-handling, undo of command ;;;              Can handle PLINETYPE = 0,1,2 ;;; 2000-03-30 - Integrating hatchb and hatchb14 ;;;              Selection of many hatches ;;;              Splines supported if closed. ;;; 2001-04-02 - Fixed bug with entmake of line with no Z for r14 ;;; 2001-07-31 - Removed an irritating semicolon to enable polylines to be created. ;;; 2001-10-04 - Changed mail and homepage so it's easy to find when new versions comes up. ;;; 2003-02-06 - Minor fix ;;; 2003-02-17 - Area returned if no islands is found since it's not consistant ;;; 2003-05-19 - Fix to take PEDITACCEPT variable used in AutoCAD 2004 into account ;;; Tested on AutoCAD r14, 2000, 2000i, 2002, 2004 ;;; should be working on older versions too. (defun c:rebuild_hatch_border () (c:hb)) ; this line can be commented out if there is an existing command called hb (defun c:hb (/     es    blay  ed1   ed2   loops1      bptf  part              et    noe   plist ic    bul   nr    ang1  ang2  obj *ModelSpace* *PaperSpace*              space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss lwp              list->variantArray 3dPoint->2dPoint A2k ent i ss2              knot-list controlpoint-list kn cn pos xv bot area hst             ) (setq A2k (>= (substr (getvar "ACADVER") 1 2) "15")) (if A2k    (progn      (defun list->variantArray (ptsList / arraySpace sArray)        (setq arraySpace           (vlax-make-safearray         vlax-vbdouble         (cons 0 (- (length ptsList) 1))           )        )        (setq sArray (vlax-safearray-fill arraySpace ptsList))        (vlax-make-variant sArray)      )      (defun areaOfObject (en / curve area)        (if en      (if A2k        (progn          (setq curve (vlax-ename->vla-object en))          (if            (vl-catch-all-error-p          (setq            area             (vl-catch-all-apply 'vlax-curve-getArea (list curve))          )            )         nil         area          )        )        (progn          (command "._area" "_O" en)          (getvar "area")        )      )        )      )    ) ) (if A2k   (defun 3dPoint->2dPoint (3dpt)     (list (float (car 3dpt)) (float (cadr 3dpt)))   ) )   (defun errexit (s)     (princ "\nError:  ")     (princ s)     (restore)   )   (defun undox ()     (command "._ucs" "_p")     (command "._undo" "_E")     (setvar "cmdecho" oldcmdecho)     (setq *error* olderr)     (princ)   )   (setq olderr  *error*         restore undox         *error* errexit   )   (setq oldcmdecho (getvar "cmdecho"))   (setvar "cmdecho" 0)   (command "._UNDO" "_BE")   (if A2k (progn     (vl-load-com)     (setq *ModelSpace* (vla-get-ModelSpace                          (vla-get-ActiveDocument (vlax-get-acad-object))                        )           *PaperSpace* (vla-get-PaperSpace                          (vla-get-ActiveDocument (vlax-get-acad-object))                        )     ))   ) ; For testing purpose ; (setq A2k nil)       (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)    (progn     (setq i 0)     (setq area 0)     (setq bMoreLoops nil)     (while (setq ent (ssname ss2 i))       (setq ed1 (entget ent))       (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch not in WCS!"))       (setq xv (cdr (assoc 210 ed1)))       (command "._ucs" "_w")       (setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)       (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))         (setq space *ModelSpace*)         (setq space *PaperSpace*)       )       (repeat loops1         (setq ed1 (member (assoc 92 ed1) ed1))         (setq bptf (cdr (car ed1))) ; boundary path type flag         (setq ic (cdr (assoc 73 ed1))) ; is closed         (setq noe (cdr (assoc 93 ed1))) ; number of edges     (setq bot (cdr (assoc 92 ed1))) ; boundary type     (setq hst (cdr (assoc 75 ed1))) ; hatch style         (setq ed1 (member (assoc 72 ed1) ed1))         (setq bul (cdr (car ed1))) ; bulge         (setq plist nil)         (setq blist nil)         (cond           ((> (boole 1 bptf 2) 0) ; polyline            (repeat noe              (setq ed1 (member (assoc 10 (cdr ed1)) ed1))              (setq plist (append plist (list (cdr (assoc 10 ed1)))))              (setq blist (append blist                                  (if (> bul 0)                                    (list (cdr (assoc 42 ed1)))                                    nil                                  )                          )              )            )            (if A2k (progn              (setq polypoints                     (apply 'append                            (mapcar '3dPoint->2dPoint plist)                     )              )              (setq VLADataPts (list->variantArray polypoints))              (setq obj (vla-addLightweightPolyline space VLADataPts))              (setq nr 0)              (repeat (length blist)                (if (/= (nth nr blist) 0)                  (vla-setBulge obj nr (nth nr blist))                )                (setq nr (1+ nr))              )              (if (= ic 1)                (vla-put-closed obj T)              )             )             (progn               (if (= ic 1)                 (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))                 (entmake '((0 . "POLYLINE") (66 . 1)))               )               (setq nr 0)               (repeat (length plist)                 (if (= bul 0)                   (entmake (list (cons 0 "VERTEX")                                  (cons 10 (nth nr plist))                            )                   )                   (entmake (list (cons 0 "VERTEX")                                  (cons 10 (nth nr plist))                                  (cons 42 (nth nr blist))                            )                   )                 )                 (setq nr (1+ nr))               )               (entmake '((0 . "SEQEND")))             )            )           )           (t ; not polyline            (setq lastent (entlast))            (setq lwp T)            (repeat noe              (setq et (cdr (assoc 72 ed1)))              (cond                ((= et 1) ; line                 (setq ed1 (member (assoc 10 (cdr ed1)) ed1))                 (if A2k                   (vla-AddLine                     space                     (vlax-3d-point (cdr (assoc 10 ed1)))                     (vlax-3d-point (cdr (assoc 11 ed1)))                   )                   (entmake                     (list                       (cons 0 "LINE")                       (list 10 (cadr (assoc 10 ed1)) (caddr (assoc 10 ed1)) 0)                       (list 11 (cadr (assoc 11 ed1)) (caddr (assoc 11 ed1)) 0)             ;  (cons 210 xv)                     )                   )                 )                 (setq ed1 (cddr ed1))                )                ((= et 2) ; circular arc                  (setq ed1 (member (assoc 10 (cdr ed1)) ed1))                  (setq ang1 (cdr (assoc 50 ed1)))                  (setq ang2 (cdr (assoc 51 ed1)))                  (setq cw (cdr (assoc 73 ed1)))                  (if (equal ang2 6.28319 0.00001)                    (progn                      (if A2k                        (vla-AddCircle                          space                          (vlax-3d-point (cdr (assoc 10 ed1)))                          (cdr (assoc 40 ed1))                        )                        (entmake (list (cons 0 "CIRCLE")                                       (assoc 10 ed1)                                       (assoc 40 ed1)                                 )                        )                      )                      (setq lwp nil)                    )                    (if A2k                      (vla-AddArc                        space                        (vlax-3d-point (cdr (assoc 10 ed1)))                        (cdr (assoc 40 ed1))                        (if (= cw 0)                          (- 0 ang2)                          ang1                        )                        (if (= cw 0)                          (- 0 ang1)                          ang2                        )                      )                      (entmake (list (cons 0 "ARC")                                     (assoc 10 ed1)                                     (assoc 40 ed1)                                     (cons 50                                           (if (= cw 0)                                             (- 0 ang2)                                             ang1                                           )                                     )                                     (cons 51                                           (if (= cw 0)                                             (- 0 ang1)                                             ang2                                           )                                     )                               )                      )                    )                  )                  (setq ed1 (cddddr ed1))                )                ((= et 3) ; elliptic arc                 (setq ed1 (member (assoc 10 (cdr ed1)) ed1))                 (setq ang1 (cdr (assoc 50 ed1)))                 (setq ang2 (cdr (assoc 51 ed1)))                 (setq cw (cdr (assoc 73 ed1)))                 (if A2k (progn                   (setq obj (vla-AddEllipse                               space                               (vlax-3d-point (cdr (assoc 10 ed1)))                               (vlax-3d-point (cdr (assoc 11 ed1)))                               (cdr (assoc 40 ed1))                             )                   )                   (vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))                   (vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))                  )                  (princ "\nElliptic arc not supported!")                 )                 (setq lwp nil)                )                ((= et 4) ; spline                 (setq ed1 (member (assoc 94 (cdr ed1)) ed1))                 (setq knot-list nil)                 (setq controlpoint-list nil)         (setq kn (cdr (assoc 95 ed1)))                 (setq cn (cdr (assoc 96 ed1)))                 (setq pos (vl-position (assoc 40 ed1) ed1))                 (repeat kn                   (setq knot-list (cons (cons 40 (cdr (nth pos ed1))) knot-list))                   (setq pos (1+ pos))                 )                 (setq pos (vl-position (assoc 10 ed1) ed1))                 (repeat cn                   (setq controlpoint-list (cons (cons 10 (cdr (nth pos ed1))) controlpoint-list))                   (setq pos (1+ pos))                 )                 (setq knot-list (reverse knot-list))                 (setq controlpoint-list (reverse controlpoint-list))                 (entmake (append                        (list '(0 . "SPLINE"))                                (list (cons 100 "AcDbEntity"))                                (list (cons 100 "AcDbSpline"))                                (list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74 ed1))) (* 4 (cdr (assoc 73 ed1))))))                                (list (cons 71 (cdr (assoc 94 ed1))))                                (list (cons 72 kn))                                (list (cons 73 cn))                                knot-list                                controlpoint-list                       )                 )         (setq ed1 (member (assoc 10 ed1) ed1))                 (setq lwp nil)                )              ) ; end cond            ) ; end repeat noe            (if lwp (progn              (setq en1 (entnext lastent))              (setq ss (ssadd))              (ssadd en1 ss)              (while (setq en2 (entnext en1))                (ssadd en2 ss)                (setq en1 en2)              )          (if (= (getvar "peditaccept") 1)                (command "_.pedit" (entlast) "_J" ss "" "")            (command "_.pedit" (entlast) "_Y" "_J" ss "" "")          )           ))           ) ; end t         ) ; end cond ;    Tries to get the area on islands but it's not clear how to know if an island is filled or not ;    and if it should be substracted or added to the total area. ;    (if (or (= bot 0) (= (boole 1 bot 1) 1)) (setq area (+ area (areaOfObject (entlast))))) ;    (if (and (/= hst 1) (/= bot 0) (= (boole 1 bot 1) 0)) (setq area (- area (areaOfObject (entlast))))) ;    (princ "\n") (princ bot) (princ "\n") (princ hst) (princ "\n") ;    (princ (areaOfObject (entlast)))       ) ; end repeat loops1       (if (= loops1 1) (setq area (+ area (areaOfObject (entlast)))) (setq bMoreLoops T))       (setq i (1+ i))     )    )   )   (if (and area (not bMoreLoops)) (progn     (princ "\nTotal Area = ")     (princ area)   ))   (restore)   (princ) )

输入HB即可!

004

看着好复杂啊。