请教各位,为什么取点总是取到原点

alwtyp

我写了一个程序,想给N个选中的物件做最小包围盒,可是PT1总是取到(0 0),找不到问题所在,发上来请各位大侠帮忙看一下.

(Defun C:Tx (/ Pt1 Pt2)
(Setvar "Cmdecho" 1)
(Setq Oldos (Getvar "Osmode"))
  (Setq Block (Ssget))
  (Setq N 0)
  (Setq Ptmin-X 0 Ptmin-Y 0 Ptmax-X 0 Ptmax-Y 0)
  (Repeat (Sslength Block)
    (Setq Ent (Cdr (Assoc -1 (Entget (Ssname Block N)))))
    (Progn
      (Vla-Getboundingbox (Vlax-Ename->Vla-Object Ent) 'Minpoint 'Maxpoint)
      (Setq Pmax (Trans (Vlax-Safearray->List Maxpoint) 0 1)
            Pmin (Trans (Vlax-Safearray->List Minpoint) 0 1))
      (progn (If(< (Car Pmin) Ptmin-X) (Setq Ptmin-X (Car Pmin)) (Setq Ptmin-X Ptmin-X))

     (If(< (Cadr Pmin) Ptmin-Y) (Setq Ptmin-Y (Cadr Pmin)) (Setq Ptmin-Y Ptmin-Y))

     (If(> (Car Pmax) Ptmax-X) (Setq Ptmax-X (Car Pmax)) (Setq Ptmax-X Ptmax-X))

     (If(> (Cadr Pmax) Ptmax-Y) (Setq Ptmax-Y (Cadr Pmax)) (Setq Ptmax-Y Ptmax-Y)))
     )
    (Setq N (1+ N))
    )
  (Setq Pt1 (List Ptmin-X Ptmin-Y)

Pt2 (List Ptmax-X Ptmax-Y))
  (Setvar "Osmode" 0)
  (vl-cmdf ".Rectang" Pt1 Pt2)
  (Setvar "Osmode" Oldos)
   ;)
(Setvar "Cmdecho" 1)
(Princ)
)

Andyhon

如果您只想绘出外框且无座标系的考量

Try this
(apply 'vl-cmdf (cons ".Rectang" (acet-geom-ss-extents (Ssget) T)))

alwtyp

回复 Andyhon 的帖子

不行,出现错误"; 错误: no function definition: ACET-GEOM-SS-EXTENTS"

Andyhon

ACET-*  需 Express Tools 支持

alwtyp

回复 Andyhon 的帖子

謝謝。在公司的機子試成了。不過也不是所有的機子都有裝EXPRESS.還想請教有沒有別的方法

Andyhon

假设 Ptss 是用 Vla-Getboundingbox 取得的全部对象点集合
(list
  (apply 'mapcar (cons 'min ptss))
  (apply 'mapcar (cons 'max ptss))
)

alwtyp

回复 Andyhon 的帖子

有點深，還不能理解

xyp1964

;; 不能预设左下角点坐标

2. (defun c:tt (/ oldos block n ent pmax pmin x1 y1 x2 y2 pn-x pn-y px-x px-y pt1 pt2)
   
3.   (setvar "cmdecho" 1)
   
4.   (setq        oldos (getvar "osmode")
   
5.         block (ssget)
   
6.         n     0
   
7.   )  
   
8.   (repeat (sslength block)
   
9.     (setq ent (ssname block n))
   
10.     (vla-getboundingbox
    
11.       (vlax-ename->vla-object ent)
    
12.       'minpoint
    
13.       'maxpoint
    
14.     )
    
15.     (setq pmax (trans (vlax-safearray->list maxpoint) 0 1)
    
16.           pmin (trans (vlax-safearray->list minpoint) 0 1)
    
17.           x1 (car pmin)
    
18.           y1 (cadr pmin)
    
19.           x2 (car pmax)
    
20.           y2 (cadr pmax)
    
21.           pn-x(if pn-x pn-x x1)
    
22.           pn-y(if pn-y pn-y y1)
    
23.           px-x(if px-x px-x x2)
    
24.           px-y(if px-y px-y y2)
    
25.           pn-x(if (< x1 pn-x) x1 pn-x)
    
26.           pn-y(if (< y1 pn-y) y1 pn-y)
    
27.           px-x(if (> x2 px-x) x2 px-x)
    
28.           px-y(if (> y2 px-y) y2 px-y)
    
29.           n (1+ n)
    
30.     )
    
31.   )
    
32.   (setq        pt1 (list pn-x pn-y)
    
33.         pt2 (list px-x px-y)
    
34.   )
    
35.   (setvar "osmode" 0)
    
36.   (vl-cmdf ".rectang" pt1 pt2)
    
37.   (setvar "osmode" oldos)
    
38.   (setvar "cmdecho" 1)
    
39.   (princ)
    
40. )

(defun c:tt (/ oldos block n ent pmax pmin x1 y1 x2 y2 pn-x pn-y px-x px-y pt1 pt2)<br />   (setvar "cmdecho" 1)<br />   (setq        oldos (getvar "osmode")<br />         block (ssget)<br />         n     0<br />   )  <br />   (repeat (sslength block)<br />     (setq ent (ssname block n))<br />     (vla-getboundingbox<br />       (vlax-ename->vla-object ent)<br />       'minpoint<br />       'maxpoint<br />     )<br />     (setq pmax (trans (vlax-safearray->list maxpoint) 0 1)<br />           pmin (trans (vlax-safearray->list minpoint) 0 1)<br />           x1 (car pmin)<br />           y1 (cadr pmin)<br />           x2 (car pmax)<br />           y2 (cadr pmax)<br />           pn-x(if pn-x pn-x x1)<br />           pn-y(if pn-y pn-y y1)<br />           px-x(if px-x px-x x2)<br />           px-y(if px-y px-y y2)<br />           pn-x(if (< x1 pn-x) x1 pn-x)<br />           pn-y(if (< y1 pn-y) y1 pn-y)<br />           px-x(if (> x2 px-x) x2 px-x)<br />           px-y(if (> y2 px-y) y2 px-y)<br />           n (1+ n)<br />     )<br />   )<br />   (setq        pt1 (list pn-x pn-y)<br />         pt2 (list px-x px-y)<br />   )<br />   (setvar "osmode" 0)<br />   (vl-cmdf ".rectang" pt1 pt2)<br />   (setvar "osmode" oldos)<br />   (setvar "cmdecho" 1)<br />   (princ)<br /> )

xyp1964

2. (defun c:tt (/ block n ptn pmax pmin x1 y1 x2 y2)
   
3.   (setq        block (ssget)
   
4.         n     0
   
5.         ptn   '()
   
6.   )
   
7.   (repeat (sslength block)
   
8.     (vla-getboundingbox
   
9.       (vlax-ename->vla-object (ssname block n))
   
10.       'minpoint
    
11.       'maxpoint
    
12.     )
    
13.     (setq pmax (vlax-safearray->list maxpoint)
    
14.           pmin (vlax-safearray->list minpoint)
    
15.           ptn  (append (list pmin pmax) ptn)
    
16.           n    (1+ n)
    
17.     )
    
18.   )
    
19.   (setq        x1 (caar (vl-sort ptn '(lambda (a b) (< (car a) (car b)))))
    
20.         y1 (cadar (vl-sort ptn '(lambda (a b) (< (cadr a) (cadr b)))))
    
21.         x2 (caar (vl-sort ptn '(lambda (a b) (> (car a) (car b)))))
    
22.         y2 (cadar (vl-sort ptn '(lambda (a b) (> (cadr a) (cadr b)))))
    
23.   )
    
24.   (vl-cmdf ".rectang" (list x1 y1) (list x2 y2))
    
25.   (princ)
    
26. )

(defun c:tt (/ block n ptn pmax pmin x1 y1 x2 y2)<br />   (setq        block (ssget)<br />         n     0<br />         ptn   '()<br />   )<br />   (repeat (sslength block)<br />     (vla-getboundingbox<br />       (vlax-ename->vla-object (ssname block n))<br />       'minpoint<br />       'maxpoint<br />     )<br />     (setq pmax (vlax-safearray->list maxpoint)<br />           pmin (vlax-safearray->list minpoint)<br />           ptn  (append (list pmin pmax) ptn)<br />           n    (1+ n)<br />     )<br />   )<br />   (setq        x1 (caar (vl-sort ptn '(lambda (a b) (< (car a) (car b)))))<br />         y1 (cadar (vl-sort ptn '(lambda (a b) (< (cadr a) (cadr b)))))<br />         x2 (caar (vl-sort ptn '(lambda (a b) (> (car a) (car b)))))<br />         y2 (cadar (vl-sort ptn '(lambda (a b) (> (cadr a) (cadr b)))))<br />   )<br />   (vl-cmdf ".rectang" (list x1 y1) (list x2 y2))<br />   (princ)<br /> )

xyp1964

;; 需要e派工具箱的支持

2. (if (setq ss (ssget))
   
3.   (xyp-rectang
   
4.     (xyp-get-ssMinMaxPoint ss 1)
   
5.     (xyp-get-ssMinMaxPoint ss 9)
   
6.   )
   
7. )

(if (setq ss (ssget))<br />   (xyp-rectang<br />     (xyp-get-ssMinMaxPoint ss 1)<br />     (xyp-get-ssMinMaxPoint ss 9)<br />   )<br /> )