有没有前辈研究过最大包围盒中心替换图形
本帖最后由 梦想家-DING 于 2023-3-2 09:36 编辑类似这样的，可否方便分享学习下
意思是先画出图形最小包围盒，再删除原图形？ ssyfeng 发表于 2023-3-2 10:04
意思是先画出图形最小包围盒，再删除原图形？
是的，现有的A图形替换现有的B图形。中心替换后确认是否删除B图形保留A图形，确定方式为空格或左键确定，取消为esc 你那演示不是写出来了嘛？ 我是没看懂究竟要做什么，你这也不是最小包围盒。不存在最大包围盒。 mikewolf2k 发表于 2023-3-2 16:16
我是没看懂究竟要做什么，你这也不是最小包围盒。不存在最大包围盒。
不知道是不是这样表达，反正是图形中心对图形中心替换。 ssyfeng 发表于 2023-3-2 15:29
你那演示不是写出来了嘛？
别人的 ;; 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.
;; sel - Selection set for which to return bounding box
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq ls1 (cons (vlax-safearray->list llp) ls1)
ls2 (cons (vlax-safearray->list urp) ls2)
)
)
)
(if (and ls1 ls2)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
)
)
Alternative Version
;; 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.
;; sel - Selection set for which to return bounding box
(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
(repeat (setq idx (sslength sel))
(setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
)
)
)
(if (and ls1 ls2) (list ls1 ls2))
) Test Program
(defun c:test ( / box obj sel spc )
(if (and (setq sel (ssget))
(setq box (LM:ssboundingbox sel))
)
(progn
(setq spc
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)
(progn
(setq obj
(vlax-invoke spc 'addlightweightpolyline
(apply 'append
(mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))
'(
(caar cadar)
(caadrcadar)
(caadr cadadr)
(caarcadadr)
)
)
)
)
)
(vla-put-closed obj :vlax-true)
(vla-put-elevation obj (caddar box))
)
(apply 'vlax-invoke
(vl-list* spc 'addbox
(apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
(apply 'mapcar (cons '- (reverse box)))
)
)
)
)
)
(princ)
)
(vl-load-com) (princ)