CJ001104最小包围框外围线方框命令为选择集的每一个图元画框.LSP

清风明月10

(defun C:bwzb (sel  / minPt maxPt obj minPt1 maxPt1)
  ; ; 来源：1楼第二套 求大侠帮我看看这个包围框的程序~-AutoLISP/Visual LISP 编程技术-CAD论坛-明经CAD社区 - Powered by Discuz!
; ; http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100044
; 这东西在按顺序检查图元时大有作用，一个一个检查，不漏一个，也不重复一个。还可以从中间 任意位置开始检查
  (setq oce (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
  (setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
  (setq obj (vlax-ename->vla-object sel))
  (vla-GetBoundingBox obj 'minpt 'maxpt)
  (setq minPt1 (vlax-safearray->list minPt))
  (setq maxPt1 (vlax-safearray->list maxPt))
  (command ".rectang" minPt1 maxPt1 "")
  (setvar "cmdecho" oce)
)


(defun C:TT (/ q a)
  (setq Q (ssget))

(setq i 0)
(repeat (sslength Q);循环选择集长度
     (setq a (ssname q I))
  (c:bwzb a)

  (setq i (1+ i))
)
)

Free-Lancer

1. (mpacar '(lambda (x) (xd::polyline:make (xdrx_entity_box x) t)) (xdrx_pickset->ents (ssget)))

(mpacar '(lambda (x) (xd::polyline:make (xdrx_entity_box x) t)) (xdrx_pickset->ents (ssget)))

Free-Lancer

就是挨个画个框来自: Android客户端

Lisphk

这程序是已经成了，还是有问题需要讨论啊？ 看里面注释好像还有问题？

wowan1314

啊啊！

2. (mapcar
   
3.     '(lambda(x)
   
4.         (vla-getboundingbox (vlax-ename->vla-object x) 'a1 'a2)
   
5.         (command "rectang" (vlax-safearray->list a1)(vlax-safearray->list a2))
   
6.     )
   
7.     (cdr(reverse(mapcar 'cadr (ssnamex (ssget))
   
8.             )
   
9.         )
   
10.     )
    
11. )

(mapcar <br />     '(lambda(x)<br />         (vla-getboundingbox (vlax-ename->vla-object x) 'a1 'a2)<br />         (command "rectang" (vlax-safearray->list a1)(vlax-safearray->list a2))<br />     )<br />     (cdr(reverse(mapcar 'cadr (ssnamex (ssget))<br />             )<br />         )<br />     )<br /> )