我已经开始为此编写代码。我的选择集包括特定图层内的所有闭合多段线。然而,我在创建过滤器以从外部区域移除内部区域的区域时遇到了问题。任何帮助创建此过滤器将不胜感激!
如果情况更糟,我可以添加代码来填充所有这些多段线形状,然后提取图案填充本身的总面积。不过,我想尽量避免这样做。。 您是希望使用单个选择集并以编程方式确定位于该集中其他多段线内的多段线,还是希望使用两个选择集:一个用于内部对象,另一个用于外部对象? 这是一种相当粗糙的方法,使用光线投射算法:
;; Polyline Area-Lee Mac
;; Prompts the user to make a selection of closed LWPolylines and returns
;; the total area of all objects in the selection, subtracting the area
;; of objects residing entirely inside other objects.
(defun c:polyarea ( / dim inc inner lst outer sel spc )
(setq
inner 0.0
outer 0.0
)
(if (setq sel (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
(progn
(setq spc
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(repeat (setq inc (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq inc (1- inc)))) lst))
)
(foreach obj1 lst
(if
(vl-some
(function
(lambda ( obj2 / int pnt tmp )
(and (null (vlax-invoke obj1 'intersectwith obj2 acextendnone))
(progn
(setq pnt (vlax-curve-getstartpoint obj1)
tmp (vla-addray spc (vlax-3D-point pnt) (vlax-3D-point (polar pnt 0.0 1.0)))
int (vlax-invoke tmp 'intersectwith obj2 acextendnone)
)
(vla-delete tmp)
(= 1 (rem (length int) 2))
)
)
)
)
(vl-remove obj1 lst)
)
(setq inner (+ inner (vla-get-area obj1)))
(setq outer (+ outer (vla-get-area obj1)))
)
)
(setq dim (getvar 'dimzin))
(setvar 'dimzin 0)
(princ
(strcat
"\nOuter Area: " (rtos outer 2
"\nInner Area: " (rtos inner 2
"\nTotal Area: " (rtos (- outer inner) 2
)
)
(setvar 'dimzin dim)
)
)
(princ)
)
(vl-load-com) (princ)
这是我的版本。。。(基于最近创建的vlax曲线getfurthestpointfrom)
M、 R。
区域形状。lsp 问题解决了!!!!
我要感谢你们两位马尔科·里巴和李·麦克。我现在可以用你的任何一个动作做我想做的。我真的很感激! Lisp再次更改为只接受闭合椭圆。。。
M、 R。
不客气lossan805 李,谢谢你,这个动作太棒了。我现有的例程设置为进行两个选择,并从另一个中选择一个。效果很好,但如果你有200个外部项目和20个内部项目是痛苦的。(即预制板总面积减去门窗。)为了使您的例程适合我,我正在尝试选择“外部”和“内部”区域值的总数!然而,我不够聪明,无法解读你优雅的逻辑
非常感谢阿马康
如果我没听错的话,这个小小的修改就足够了:
;; Polyline Area-Lee Mac
;; Prompts the user to make a selection of closed LWPolylines and returns
;; the total area of all objects in the selection, subtracting the area
;; of objects residing entirely inside other objects.
(defun c:polyarea ( / dim inc inner ino lst ono outer sel spc )
(setq
inner 0.0
outer 0.0
ino 0
ono 0
)
(if (setq sel (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
(progn
(setq spc
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(repeat (setq inc (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq inc (1- inc)))) lst))
)
(foreach obj1 lst
(if
(vl-some
(function
(lambda ( obj2 / int pnt tmp )
(and (null (vlax-invoke obj1 'intersectwith obj2 acextendnone))
(progn
(setq pnt (vlax-curve-getstartpoint obj1)
tmp (vla-addray spc (vlax-3D-point pnt) (vlax-3D-point (polar pnt 0.0 1.0)))
int (vlax-invoke tmp 'intersectwith obj2 acextendnone)
)
(vla-delete tmp)
(= 1 (rem (length int) 2))
)
)
)
)
(vl-remove obj1 lst)
)
(setq inner (+ inner (vla-get-area obj1))
ino (1+ ino)
)
(setq outer (+ outer (vla-get-area obj1))
ono (1+ ono)
)
)
)
(setq dim (getvar 'dimzin))
(setvar 'dimzin 0)
(princ
(strcat
"\nOuter Area: " (rtos outer 2" from " (itoa ono) " object(s)."
"\nInner Area: " (rtos inner 2" from " (itoa ino) " object(s)."
"\nTotal Area: " (rtos (- outer inner) 2
)
)
(setvar 'dimzin dim)
)
)
(princ)
)
(vl-load-com) (princ)
李,你好!!!
页:
1
[2]