alwtyp 发表于 2011-4-12 21:06:53

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

我写了一个程序,想给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 发表于 2011-4-12 22:07:06

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

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

alwtyp 发表于 2011-4-12 22:13:53

回复 Andyhon 的帖子

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

Andyhon 发表于 2011-4-12 22:52:13

ACET-*需 Express Tools 支持

alwtyp 发表于 2011-4-13 08:28:02

回复 Andyhon 的帖子

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

Andyhon 发表于 2011-4-13 10:56:01

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

alwtyp 发表于 2011-4-13 17:27:31

回复 Andyhon 的帖子

有點深，還不能理解

xyp1964 发表于 2011-4-13 18:12:24

;; 不能预设左下角点坐标(defun c:tt (/ oldos block n ent pmax pmin x1 y1 x2 y2 pn-x pn-y px-x px-y pt1 pt2)
(setvar "cmdecho" 1)
(setq        oldos (getvar "osmode")
        block (ssget)
        n   0
)
(repeat (sslength block)
    (setq ent (ssname block n))
    (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)
          x1 (car pmin)
          y1 (cadr pmin)
          x2 (car pmax)
          y2 (cadr pmax)
          pn-x(if pn-x pn-x x1)
          pn-y(if pn-y pn-y y1)
          px-x(if px-x px-x x2)
          px-y(if px-y px-y y2)
          pn-x(if (< x1 pn-x) x1 pn-x)
          pn-y(if (< y1 pn-y) y1 pn-y)
          px-x(if (> x2 px-x) x2 px-x)
          px-y(if (> y2 px-y) y2 px-y)
          n (1+ n)
    )
)
(setq        pt1 (list pn-x pn-y)
        pt2 (list px-x px-y)
)
(setvar "osmode" 0)
(vl-cmdf ".rectang" pt1 pt2)
(setvar "osmode" oldos)
(setvar "cmdecho" 1)
(princ)
)

xyp1964 发表于 2011-4-13 18:23:01

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

xyp1964 发表于 2011-4-13 18:24:40

;; 需要e派工具箱的支持(if (setq ss (ssget))
(xyp-rectang
    (xyp-get-ssMinMaxPoint ss 1)
    (xyp-get-ssMinMaxPoint ss 9)
)
)
页: [1] 2
查看完整版本: 请教各位,为什么取点总是取到原点