将SS移动到Bpoly的质心
大家好！我将尝试解释我要做的事情：
1.创建选择集并找到其bbox的中心
2.创建bpoly，在封闭区域内拾取，并找到其bbox的中心
3.将所选内容从其中心移动到B多边形的中心
4、删除bpoly
目前，我正在修改Tharwat的一些代码（并添加了Lee Mac的一些函数），但我现在陷入了困境，找不到我的错误：
;Credits: Tharwat, Lee Mac
(defun c:test (/ s1 l1 cen1 doc e o u spc reg obj cen2)
(princ "\nSelect objects to move from their center")
(setq s1 (ssget "_:L"))
(setq l1 (LM:ssboundingbox s1 ))
(setq cen1 (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) l1)) )
(setq e (entlast))
(if (and (vl-cmdf "_.-boundary" "\\" "\\")
(setq o (entlast))
(not (eq e o))
(eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
)
(progn
(setq doc (vla-get-activedocument (vlax-get-acad-object)) )
(setq spc (vla-get-block (vla-item (vla-get-layouts doc) (getvar 'ctab))) )
(setq reg (vlax-invoke spc 'addregion (list (setq obj (vlax-ename->vla-object o)))) )
(if
(setq cen2 (vlax-3d-point (append (vlax-get (car reg) 'centroid) (list 0.))) )
(progn
(command "_move" s1 "" "_non" cen1 "_non" cen2 )
(mapcar 'vla-delete o)
(vla-delete (car reg))
);progn
);if
);progn
);if
;vlax-safearray->list (vlax-variant-value VAR))
(princ)
)
;; 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 ( / box ent ply pnt reg sel )
(cond
( (not (setq sel (ssget "_:L"))))
( (not (setq box (LM:ssboundingbox sel)))
(princ "\nUnable to calculate bounding box for selection.")
)
( (not (setq pnt (getpoint "\nSpecify point within bounded area: "))))
( (progn
(setq ent (entlast))
(vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" pnt "")
(eq ent (setq ply (entlast)))
)
(princ "\nUnable to determine boundary from given point.")
)
( (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 ply))
)
)
)
)
(princ "\nUnable to create region from boundary.")
)
( (vl-cmdf "_.move" sel ""
"_non" (trans (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box)) 0 1)
"_non" (vlax-get (car reg) 'centroid)
)
)
)
(if (and (= 'ename (type ply)) (entget ply))
(entdel ply)
)
(if (and (= 'vla-object (type (car reg))) (vlax-write-enabled-p (car reg)))
(vla-delete (car reg))
)
(princ)
)
;; 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) 非常感谢你，李！
从您的更正来看，代码似乎重写了一半。（但这很好——它现在有了专业的触感！）
我将例程命名为“MatchCenterBPOLY”
如果你不介意的话，我将写下你作为作者的昵称。
顺便说一句，当创建（窗/门）Schledule时（当使用手动绘制的表时），这个例程非常棒。
页:
[1]