修改外围框单边各加10mm

hnzkhyyl

我在百度里搜出朱老师写的一个最大外围框的lisp程式.看得不太懂.想改成,最大外围的四边再单边各加10mm,有没有大佬帮忙改一下怎么改?

vitalgg

offset 偏移量设为 10 即可

yshf

只需要在
(setq sx (s1905271 y1 y2) y1 (car sx) y2 (cadr sx))
后加一行，即可
(setq x1 (+ x1 10) x2 (+ x2 10) y1 (+ y1 10) y2 (+ y2 10))

hnzkhyyl

getbox，选择的东西一多，程序运行就很慢。朱老师写的这个会相对快一些。不知道从哪里修改能单边加大10mm

飞雪神光

hnzkhyyl 发表于 2023-5-9 07:12
getbox，选择的东西一多，程序运行就很慢。朱老师写的这个会相对快一些。不知道从哪里修改能单边加大10mm

1. ;;最大外围框
   
2. (defun c:tes (/ &kw ent s1905271 ss1 sx x1 x1903211 x2 y1 y2)
   
3.   (vl-load-com)
   
4.   ;长度为整数
   
5.   (defun s1905271 (i1 i2 / i i1 i2 i3 i4)
   
6.     (setq i3 (* 0.5 (+ i2 i1)) i4 (- i2 i1) i (atof (rtos i4 2 0)))
   
7.     (if (> i4 i) (setq i (+ i 1)) )
   
8.     (setq i (* 0.5 i))
   
9.     (list (- i3 i) (+ i3 i))
   
10.   )
    
11.   (defun x1903211 (obj / obj x y)
    
12.     (vla-getboundingbox obj 'x 'y)
    
13.     (mapcar 'vlax-safearray->list (list x y));点表
    
14.   )
    
15.   (princ "\n请选择对象")
    
16.   (if (setq &kw (ssget))
    
17.     (progn
    
18.       (setq ss1 '())
    
19.       (while (setq ent (ssname &kw 0))
    
20.         (setq &kw (ssdel ent &kw) ss1 (cons ent ss1))
    
21.       );while
    
22.       (setq ss1 (mapcar 'vlax-ename->vla-object ss1))
    
23.       (setq ss1 (apply 'append (mapcar 'x1903211 ss1)))
    
24.       (setq sx (vl-sort (mapcar 'car ss1) '<))
    
25.       (setq x1 (car sx) x2 (last sx))
    
26.       (setq sx (s1905271 x1 x2) x1 (car sx) x2 (cadr sx))
    
27.       (setq sx (vl-sort (mapcar 'cadr ss1) '<))
    
28.       (setq y1 (car sx) y2 (last sx))
    
29.       (setq sx (s1905271 y1 y2) y1 (car sx) y2 (cadr sx))
    
30.       (setq x1 (- x1 10) x2 (+ x2 10) y1 (- y1 10) y2 (+ y2 10))
    
31.       (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) '(38 . 0) (cons 10 (list x1 y1)) (cons 10 (list x2 y1)) (cons 10 (list x2 y2)) (cons 10 (list x1 y2))))
    
32.     )
    
33.   )
    
34.   (princ)
    
35. )
    

;;最大外围框<br /> (defun c:tes (/ &kw ent s1905271 ss1 sx x1 x1903211 x2 y1 y2)<br />   (vl-load-com)<br />   ;长度为整数<br />   (defun s1905271 (i1 i2 / i i1 i2 i3 i4)<br />     (setq i3 (* 0.5 (+ i2 i1)) i4 (- i2 i1) i (atof (rtos i4 2 0)))<br />     (if (> i4 i) (setq i (+ i 1)) )<br />     (setq i (* 0.5 i))<br />     (list (- i3 i) (+ i3 i))<br />   )<br />   (defun x1903211 (obj / obj x y)<br />     (vla-getboundingbox obj 'x 'y)<br />     (mapcar 'vlax-safearray->list (list x y));点表<br />   )<br />   (princ "\n请选择对象")<br />   (if (setq &kw (ssget))<br />     (progn<br />       (setq ss1 '())<br />       (while (setq ent (ssname &kw 0))<br />         (setq &kw (ssdel ent &kw) ss1 (cons ent ss1))<br />       );while<br />       (setq ss1 (mapcar 'vlax-ename->vla-object ss1))<br />       (setq ss1 (apply 'append (mapcar 'x1903211 ss1)))<br />       (setq sx (vl-sort (mapcar 'car ss1) '<))<br />       (setq x1 (car sx) x2 (last sx))<br />       (setq sx (s1905271 x1 x2) x1 (car sx) x2 (cadr sx))<br />       (setq sx (vl-sort (mapcar 'cadr ss1) '<))<br />       (setq y1 (car sx) y2 (last sx))<br />       (setq sx (s1905271 y1 y2) y1 (car sx) y2 (cadr sx))<br />       (setq x1 (- x1 10) x2 (+ x2 10) y1 (- y1 10) y2 (+ y2 10))<br />       (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) '(38 . 0) (cons 10 (list x1 y1)) (cons 10 (list x2 y1)) (cons 10 (list x2 y2)) (cons 10 (list x1 y2))))<br />     )<br />   )<br />   (princ)<br /> )<br />

kucha007

yshf 发表于 2023-5-9 07:06
只需要在
(setq sx (s1905271 y1 y2) y1 (car sx) y2 (cadr sx))
后加一行，即可

y是加，x应该是减

hnzkhyyl

谢谢楼上的各位大佬，现在可以了

linzenghuo

(setq x1 (- x1 10) x2 (+ x2 10) y1 (- y1 10) y2 (+ y2 10))