有没有前辈研究过最大包围盒中心替换图形

梦想家-DING

类似这样的，可否方便分享学习下

ssyfeng

意思是先画出图形最小包围盒，再删除原图形？

梦想家-DING

ssyfeng 发表于 2023-3-2 10:04
意思是先画出图形最小包围盒，再删除原图形？

是的，现有的A图形替换现有的B图形。中心替换后确认是否删除B图形保留A图形，确定方式为空格或左键确定，取消为esc

ssyfeng

你那演示不是写出来了嘛？

mikewolf2k

我是没看懂究竟要做什么，你这也不是最小包围盒。不存在最大包围盒。

梦想家-DING

mikewolf2k 发表于 2023-3-2 16:16
我是没看懂究竟要做什么，你这也不是最小包围盒。不存在最大包围盒。

不知道是不是这样表达，反正是图形中心对图形中心替换。

梦想家-DING

ssyfeng 发表于 2023-3-2 15:29
你那演示不是写出来了嘛？

别人的

sachindkini

2. ;; Selection Set Bounding Box  -  Lee Mac
   
3. ;; Returns a list of the lower-left and upper-right WCS coordinates of a
   
4. ;; rectangular frame bounding all objects in a supplied selection set.
   
5. ;; sel - [sel] Selection set for which to return bounding box
   
6. 
   
7. (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
   
8.     (repeat (setq idx (sslength sel))
   
9.         (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
   
10.         (if (and (vlax-method-applicable-p obj 'getboundingbox)
    
11.                  (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
    
12.             )
    
13.             (setq ls1 (cons (vlax-safearray->list llp) ls1)
    
14.                   ls2 (cons (vlax-safearray->list urp) ls2)
    
15.             )
    
16.         )
    
17.     )
    
18.     (if (and ls1 ls2)
    
19.         (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    
20.     )
    
21. )

;; Selection Set Bounding Box  -  Lee Mac<br /> ;; Returns a list of the lower-left and upper-right WCS coordinates of a<br /> ;; rectangular frame bounding all objects in a supplied selection set.<br /> ;; sel - [sel] Selection set for which to return bounding box<br /> <br /> (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )<br />     (repeat (setq idx (sslength sel))<br />         (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))<br />         (if (and (vlax-method-applicable-p obj 'getboundingbox)<br />                  (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))<br />             )<br />             (setq ls1 (cons (vlax-safearray->list llp) ls1)<br />                   ls2 (cons (vlax-safearray->list urp) ls2)<br />             )<br />         )<br />     )<br />     (if (and ls1 ls2)<br />         (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))<br />     )<br /> )

sachindkini

Alternative Version

2. ;; Selection Set Bounding Box  -  Lee Mac
   
3. ;; Returns a list of the lower-left and upper-right WCS coordinates of a
   
4. ;; rectangular frame bounding all objects in a supplied selection set.
   
5. ;; sel - [sel] Selection set for which to return bounding box
   
6. 
   
7. (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
   
8.     (repeat (setq idx (sslength sel))
   
9.         (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
   
10.         (if (and (vlax-method-applicable-p obj 'getboundingbox)
    
11.                  (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
    
12.             )
    
13.             (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))
    
14.                   ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))
    
15.             )
    
16.         )
    
17.     )
    
18.     (if (and ls1 ls2) (list ls1 ls2))
    
19. )

;; Selection Set Bounding Box  -  Lee Mac<br /> ;; Returns a list of the lower-left and upper-right WCS coordinates of a<br /> ;; rectangular frame bounding all objects in a supplied selection set.<br /> ;; sel - [sel] Selection set for which to return bounding box<br /> <br /> (defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )<br />     (repeat (setq idx (sslength sel))<br />         (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))<br />         (if (and (vlax-method-applicable-p obj 'getboundingbox)<br />                  (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))<br />             )<br />             (setq ls1 (mapcar 'min (vlax-safearray->list llp) (cond (ls1) ((vlax-safearray->list llp))))<br />                   ls2 (mapcar 'max (vlax-safearray->list urp) (cond (ls2) ((vlax-safearray->list urp))))<br />             )<br />         )<br />     )<br />     (if (and ls1 ls2) (list ls1 ls2))<br /> )

sachindkini

Test Program

2. (defun c:test ( / box obj sel spc )
   
3.     (if (and (setq sel (ssget))
   
4.              (setq box (LM:ssboundingbox sel))
   
5.         )
   
6.         (progn
   
7.             (setq spc
   
8.                 (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
   
9.                     (if (= 1 (getvar 'cvport))
   
10.                         'paperspace
    
11.                         'modelspace
    
12.                     )
    
13.                 )
    
14.             )
    
15.             (if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)
    
16.                 (progn
    
17.                     (setq obj
    
18.                         (vlax-invoke spc 'addlightweightpolyline
    
19.                             (apply 'append
    
20.                                 (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))
    
21.                                    '(
    
22.                                         (caar   cadar)
    
23.                                         (caadr  cadar)
    
24.                                         (caadr cadadr)
    
25.                                         (caar  cadadr)
    
26.                                     )
    
27.                                 )
    
28.                             )
    
29.                         )
    
30.                     )
    
31.                     (vla-put-closed obj :vlax-true)
    
32.                     (vla-put-elevation obj (caddar box))
    
33.                 )
    
34.                 (apply 'vlax-invoke
    
35.                     (vl-list* spc 'addbox
    
36.                         (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))
    
37.                         (apply 'mapcar (cons '- (reverse box)))
    
38.                     )
    
39.                 )
    
40.             )
    
41.         )
    
42.     )
    
43.     (princ)
    
44. )
    
45. (vl-load-com) (princ)

(defun c:test ( / box obj sel spc )<br />     (if (and (setq sel (ssget))<br />              (setq box (LM:ssboundingbox sel))<br />         )<br />         (progn<br />             (setq spc<br />                 (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))<br />                     (if (= 1 (getvar 'cvport))<br />                         'paperspace<br />                         'modelspace<br />                     )<br />                 )<br />             )<br />             (if (equal 0.0 (apply '- (mapcar 'caddr box)) 1e-6)<br />                 (progn<br />                     (setq obj<br />                         (vlax-invoke spc 'addlightweightpolyline<br />                             (apply 'append<br />                                 (mapcar '(lambda ( x ) (mapcar '(lambda ( y ) ((eval y) box)) x))<br />                                    '(<br />                                         (caar   cadar)<br />                                         (caadr  cadar)<br />                                         (caadr cadadr)<br />                                         (caar  cadadr)<br />                                     )<br />                                 )<br />                             )<br />                         )<br />                     )<br />                     (vla-put-closed obj :vlax-true)<br />                     (vla-put-elevation obj (caddar box))<br />                 )<br />                 (apply 'vlax-invoke <br />                     (vl-list* spc 'addbox<br />                         (apply 'mapcar (cons '(lambda ( a b ) (/ (+ a b) 2.0)) box))<br />                         (apply 'mapcar (cons '- (reverse box)))<br />                     )<br />                 )<br />             )<br />         )<br />     )<br />     (princ)<br /> )<br /> (vl-load-com) (princ)