图形最大外形的点坐标

yxl88168

求一个能框选图形后(如下图一所示的图形)，自动算出图形的最大外形(如图2的洋红色线)，并给出最大外形上的4个点 pt1 pt2 pt3 pt4  的坐标值，不需要画出最大外形,谢谢了

yxp

vla-getboundingbox 的典型用法：

;;调用 (GetsBox  (ssget)) 即可
(defun GetsBox (ss / n zx ys x y)
(repeat (setq n (sslength ss))
(vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq n (1- n)))) 'x 'y)
(setq zx (cons (vlax-safearray->list x) zx)
        ys (cons (vlax-safearray->list y) ys))
)(mapcar '(lambda(a b)(apply 'mapcar (cons a b)))'(min max)(list zx ys))
)

nzl1116

2. ;;;点表的左下点和右上点
   
3. (defun AYL-GetBoxAtPtLst (PtLst)
   
4.   (list
   
5.     (apply (function mapcar) (cons (function min) PtLst))
   
6.     (apply (function mapcar) (cons (function max) PtLst))
   
7.   )
   
8. )

;;;点表的左下点和右上点<br /> (defun AYL-GetBoxAtPtLst (PtLst)<br />   (list<br />     (apply (function mapcar) (cons (function min) PtLst))<br />     (apply (function mapcar) (cons (function max) PtLst))<br />   )<br /> )

yxl88168

nzl1116 发表于 2018-4-3 15:53

能把4个角的坐标都搞出来吗

yxl88168

要支持图块哦，因为有些图是图块的

yxl88168

yxp 发表于 2018-4-3 15:09
vla-getboundingbox 的典型用法：

;;调用 (GetsBox  (ssget)) 即可

谢谢院长，我试试

yxl88168

@yxp @nzl1116 能详细点吗，我想要的就是如下图所示的程序的那样的4个点，我可以把那4个点pt1  pt2  pt3  pt4拿来画线或者做别的什么，谢谢了

2. (defun C:34 (/ PT1 PT2 PT3 PT4)
   
3.    (graphscr)
   
4.    (setq oldlay (getvar "clayer"))
   
5. (setq nl(car (entsel "選取:")))
   
6. (vla-getboundingbox (vlax-ename->vla-object nl) 'll 'ur)
   
7. (setq pt1 (vlax-safearray->list ll))
   
8. (setq pt3 (vlax-safearray->list ur))
   
9.    (setq PT2 (list (car PT1)(cadr PT3)))
   
10.    (setq PT4 (list (car PT3)(cadr PT1)))
    
11.    (command "Pline" PT1 PT3 "")
    
12.    (command "Pline" PT2 PT4 "")
    
13.    (command "RECTANGLE" PT1 PT3 "")
    
14.   (command "color" "bylayer")
    
15.    (setvar "clayer" oldlay)

(defun C:34 (/ PT1 PT2 PT3 PT4)<br />    (graphscr)<br />    (setq oldlay (getvar "clayer"))<br /> (setq nl(car (entsel "選取:")))<br /> (vla-getboundingbox (vlax-ename->vla-object nl) 'll 'ur)<br /> (setq pt1 (vlax-safearray->list ll))<br /> (setq pt3 (vlax-safearray->list ur))<br />    (setq PT2 (list (car PT1)(cadr PT3)))<br />    (setq PT4 (list (car PT3)(cadr PT1)))<br />    (command "Pline" PT1 PT3 "")<br />    (command "Pline" PT2 PT4 "")<br />    (command "RECTANGLE" PT1 PT3 "")<br />   (command "color" "bylayer")<br />    (setvar "clayer" oldlay)

yxp

加载GetssBox后执行:
(command "RECTANG" (car (setq pt (GetssBox (ssget)))) (cadr pt))

yxl88168

yxp 发表于 2018-4-3 21:30
加载GetssBox后执行:
(command "RECTANG" (car (setq pt (GetssBox (ssget)))) (cadr pt))

我不是要最大外形，我要的是4个点，

xyp1964

应该是最小外包矩形