自动生成边界线程序的完善

kinger

这个自动加边界线程序是网上下载的，很好用，但是它只能生成一个整体的边界线，高手可以优化一下吗，改为可以批量选择图框块，并给每个图框块生成边界线。

2. (defun c:bjh (/ ss i l1 l2 ll ur os d)
   
3.   (setq os (getvar 'osmode))
   
4.   (PRINC "\n自动边界盒 ")(PRINC)  
   
5.   (setq d (getreal "\n偏距<5>"))
   
6.   (if (null d)
   
7.     (setq d 5)
   
8.   )
   
9.   (setq ss (ssget))
   
10.   (repeat (setq i (sslength ss))
    
11.     (vla-getboundingbox
    
12.       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
    
13.       'll
    
14.       'ur
    
15.     )
    
16.     (setq l1 (cons (vlax-safearray->list ll) l1)
    
17.           l2 (cons (vlax-safearray->list ur) l2)
    
18.     )
    
19.   )
    
20.   (mapcar 'set
    
21.           (list 'll 'ur)
    
22.           (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
    
23.                   '(min max)
    
24.                   (list l1 l2)
    
25.           )
    
26.   )
    
27.   (command
    
28.     "rectang"
    
29.     (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
    
30.            0
    
31.            1
    
32.     )
    
33.     (trans (polar ur (* pi 0.25) d) 0 1)
    
34.   )
    
35.   (setvar 'osmode os)
    
36.   (princ)
    
37. )

(defun c:bjh (/ ss i l1 l2 ll ur os d)<br />   (setq os (getvar 'osmode))<br />   (PRINC "\n自动边界盒 ")(PRINC)  <br />   (setq d (getreal "\n偏距<5>"))<br />   (if (null d)<br />     (setq d 5)<br />   )<br />   (setq ss (ssget))<br />   (repeat (setq i (sslength ss))<br />     (vla-getboundingbox<br />       (vlax-ename->vla-object (ssname ss (setq i (1- i))))<br />       'll<br />       'ur<br />     )<br />     (setq l1 (cons (vlax-safearray->list ll) l1)<br />           l2 (cons (vlax-safearray->list ur) l2)<br />     )<br />   )<br />   (mapcar 'set<br />           (list 'll 'ur)<br />           (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))<br />                   '(min max)<br />                   (list l1 l2)<br />           )<br />   )<br />   (command<br />     "rectang"<br />     (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))<br />            0<br />            1<br />     )<br />     (trans (polar ur (* pi 0.25) d) 0 1)<br />   )<br />   (setvar 'osmode os)<br />   (princ)<br /> )

kinger

自己顶一下

                                        藏起来的小尾巴,不让你看!  

muwind

2. (defun c:bjTK (/ ss i l1 l2 ll ur os d)
   
3.   (setq os (getvar 'osmode))
   
4.   (setq ss (ssget "X" '( (2 . "*图框名*"))))
   
5.   (setvar 'osmode 0)
   
6.   (repeat (setq i (sslength ss))
   
7.     (vla-getboundingbox
   
8.       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
   
9.       'll
   
10.       'ur
    
11.     )
    
12.     (setq l1 (vlax-safearray->list ll)
    
13.           l2 (vlax-safearray->list ur)
    
14.     )
    
15.         (command   "rectang"  (list (car l1) (cadr l1))  (list (car l2) (cadr l2))  )
    
16.   )
    
17.   (setvar 'osmode os)
    
18.   (princ)
    
19. )

(defun c:bjTK (/ ss i l1 l2 ll ur os d)<br />   (setq os (getvar 'osmode))<br />   (setq ss (ssget "X" '( (2 . "*图框名*"))))<br />   (setvar 'osmode 0)<br />   (repeat (setq i (sslength ss))<br />     (vla-getboundingbox<br />       (vlax-ename->vla-object (ssname ss (setq i (1- i))))<br />       'll<br />       'ur<br />     )<br />     (setq l1 (vlax-safearray->list ll)<br />           l2 (vlax-safearray->list ur)<br />     )<br />         (command   "rectang"  (list (car l1) (cadr l1))  (list (car l2) (cadr l2))  ) <br />   )<br />   (setvar 'osmode os)<br />   (princ)<br /> )

guosheyang

       对你的代码做个简单的修改，外面加一层循环  对新手来说  可执行就行了
;执行(tt(setq s(ssget)))
(defun tt(s / D I S0)
   (PRINC "\n自动边界盒 ")(PRINC)  
   (setq d (getreal "\n偏距<5>"))
   (if (null d)
    (setq d 5)
   )
   (repeat(setq i(sslength s))
        (ssadd (ssname s (setq i(1- i)))(setq s0(ssadd)))
        (bjh s0 d)
   )
)
(defun bjh (ss d / A B I L1 L2 LL OS UR)
  (setq os (getvar 'osmode))
  (repeat (setq i (sslength ss))
    (vla-getboundingbox
      (vlax-ename->vla-object (ssname ss (setq i (1- i))))
      'll
      'ur
    )
    (setq l1 (cons (vlax-safearray->list ll) l1)
          l2 (cons (vlax-safearray->list ur) l2)
    )
  )
(mapcar 'set
          (list 'll 'ur)
          (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
                  '(min max)
                  (list l1 l2)
          )
  )
  (command
    "rectang"
    "non"
    (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
           0
           1
    )
     "non"
    (trans (polar ur (* pi 0.25) d) 0 1)
  )
  (setvar 'osmode os)
  (princ)
)

hm6313967

我看过老外的一个最大边界   可以识别样条曲线 多线段 圆弧 直线  块  速度快 精度高    可以设置容差！  是C#写的   LSP 目前还没有发现有能做到的！ 期待国内大神的杰作！