MatchCenInsPoly。lsp
大家好！所以我发现了这件事，现在我正在对代码进行猛烈抨击，
思考它为什么不起作用。
让我解释一下：
此例程只期望用户提供一个选择集：
1.所选内容只能包含闭合多段线
2.例程查找每个多段线（质心）的边界框
3.然后选择每个多段线内的对象，并找到其边界框（质心）
4.然后将内部对象从其bbox的中心移动到多边形的中心
我已经组装好了，但我不知道离完成还有多远：
; Method for selecting the polys:
; Simplier: with "entsel"
; Harder: with "ssget" method
; Get individual bounding box for each object (pline)
; Get individual bounding box for each selection inside each object
; Possible problems:
; (princ "\nYou must select polyline")
; (princ "\nThe polyline must be closed")
; (princ (strcat "\nThere are " (sslength ss) " selected open polylines, removing them from selection. "))
; null selection inside a closed poly
; Current problem, first theres selection "sel-polys", then theres selection "inside-sel":
(defun c:test ( / ent-ply sel-polys inside-sel box-polys box-insidesel reg pl_obj pt_lst_cnt pt_lst )
; To select plines only
(setq entitytype "*POLYLINE")
(if
(and (princ "\nSelect slots (closed polylines)") (setq sel-polys ((ssget "_:L")(list (cons 0 entitytype))))
);and
; Repeat this for each polyline in the selection :
(repeat
(setq idx (sslength sel-polys))
(setq ent-ply (ssname sel-polys (setq idx (1- idx))))
(setq box-polys (LM:ssboundingbox (vlax-ename->vla-object ent-ply )) )
(cond
; To check if the poly is closed:
((not
(vlax-property-available-p
(setq obj (vlax-ename->vla-object ent-ply)) 'Area
)
)
(princ "\n** Invalid Object Selected **")
)
; Construct the region to get the centroid for poly:
( (vl-catch-all-error-p
(setq reg
(vl-catch-all-apply 'vlax-invoke
(list
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
'addregion (list (vlax-ename->vla-object ent-ply ))
)
)
)
)
(princ "\nUnable to create region from boundary.")
)
; Get the objects inside the closed polyline "inside-sel" :
( (setq pl_obj (vlax-ename->vla-object ent-ply) cc (vla-get-Coordinates pl_obj))
(setq pt_lst_cnt (/ (length (vlax-safearray->list (vlax-variant-value cc))) 2 ))
(setq cntr 0)
(repeat pt_lst_cnt
(setq pt_lst (cons (vlax-safearray->list (vlax-variant-value (vla-get-Coordinate pl_obj cntr))) pt_lst ) cntr (1+ cntr))
);repeat
(setq inside-sel (ssget "_WP" pt_lst ))
;(sssetfirst nil inside-sel) ;<- DO I NEED TO DISSELECT "sel-polys" ???
)
; Get the "inside-sel" bounding box:
( (not (setq box-insidesel (LM:ssboundingbox inside-sel)))
(princ "\nUnable to calculate bounding box for selection.")
)
; Check if "inside-sel" is empty
; Move the "inside-sel" objects inside the polyline, from their centroid, to match the poly's centroid:
( (not (null inside-sel))
(vl-cmdf "_.move" inside-sel ""
"_non" (trans (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box-insidesel)) 0 1)
"_non" (vlax-get (car reg) 'centroid)
);vl-cmdf
(princ "\nThe polyline is empty nothing selected ")
)
);cond
); end of repeat
);if
(princ)
);defun
;; Selection Set Bounding Box-Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
(vl-load-com) (princ)
像往常一样，我不在乎学分，所以只要它起作用，请随意获取版权！ 以下是一些代码供您考虑：
(defun c:test ( / b e i l m s x )
(if (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
(repeat (setq i (sslength s))
(setq e (ssname s (setq i (1- i)))
l (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget e)))
)
(if (and (setq m (ssget "_WP" l))
(or (not (ssmemb e m)) (ssdel e m))
(< 0 (sslength m))
(setq b (LM:ssboundingbox m))
)
(vl-cmdf "_.move" m ""
"_non" (trans (LM:listmid b) 0 1)
"_non" (trans (LM:listmid l) e 1)
)
)
)
)
(princ)
)
(defun LM:listmid ( lst )
((lambda ( n ) (mapcar '(lambda ( x ) (/ x n)) (apply 'mapcar (cons '+ lst)))) (length lst))
)
;; Selection Set Bounding Box-Lee Mac
;; Returns a list of the lower-left and upper-right WCS coordinates of a
;; rectangular frame bounding all objects in a supplied selection set.
;; s - Selection set for which to return bounding box
(defun LM:ssboundingbox ( s / a b i m n o )
(repeat (setq i (sslength s))
(if
(and
(setq o (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(vlax-method-applicable-p o 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
)
(setq m (cons (vlax-safearray->list a) m)
n (cons (vlax-safearray->list b) n)
)
)
)
(if (and m n)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list m n))
)
)
(vl-load-com) (princ)
请注意，要移动的对象必须在绘图区域中可见，以便ssget“WP”检测到它们。 李，你好，
我没想到这个代码会这么短，
也解释了为什么我只懂一半！
我只有一个问题：
您是如何确定多段线是否闭合的？
由于其“神奇”的性能，这个例程可以成为您网站的一个不错的补充。
我很高兴你帮了我！
DXF组70代码是位编码的，因此需要位掩码（“&=”）来确定是否设置了位1。
也许-虽然，可能有数百个程序，我已经在论坛上分享，但没有添加到我的网站。。。
尽管如此，我很高兴能帮上忙。 我真的很感谢你的时间和帮助，
我不知道你在这一点上花了多少精力写程序，在你背后收集了这么多的知识并在论坛上传播。
“谢谢”这个词一定让你很烦。
页:
[1]