麻烦帮忙在这个代码加一个循环

e719

我加了一个，它循环时吧前面加的框也加进去了，麻烦各位大神帮我加一个，最好把外形做个整数和把距离变成默认的。谢谢~

1. (defun c:wk (/ ss i l1 l2 ll ur os d)
   
2.   (defun *MYERR* (MSG)
   
3. (setvar "CMDECHO" CMD_OLD)
   
4. (setvar "OSMODE" OS_OLD)
   
5. (setq *ERROR* *OLDERR*)
   
6. (if (= MSG "完美退出。谢谢使用。")
   
7.      (princ (strcat "\\n>>>" MSG))
   
8.      (princ "\n>>>虽然中途退出了，对象捕捉已经被恢复。")
   
9. )
   
10. (princ)
    
11.     )
    
12.     (setq *OLDERR* *ERROR*
    
13.    *ERROR*  *MYERR*
    
14.    OS_OLD   (getvar "OSMODE")
    
15.    CMD_OLD  (getvar "CMDECHO")
    
16.     )
    
17. (setvar "CMDECHO" 0);_关闭命令提示
    
18. (Setq osmode_bak (getvar "osmode"));_记录捕捉
    
19. (Setvar "osmode" 0);_关闭捕捉
    
20. 
    
21. (if *Scale* (setq d (getreal (strcat  "\n偏距<" (rtos *Scale* 2 2) ">:") ) )  (setq d (getreal  "\n偏
    
22. 
    
23. 距:")))
    
24. (if (null d) (setq d *Scale*) (setq *Scale*  d ))
    
25. 
    
26. (setq ss (ssget))
    
27.   (repeat (setq i (sslength ss))
    
28.     (vla-getboundingbox
    
29.       (vlax-ename->vla-object (ssname ss (setq i (1- i))))
    
30.       'll
    
31.       'ur
    
32.     )
    
33.     (setq l1 (cons (vlax-safearray->list ll) l1)
    
34.           l2 (cons (vlax-safearray->list ur) l2)
    
35.     )
    
36.   )
    
37.   (mapcar 'set
    
38.           (list 'll 'ur)
    
39.           (mapcar '(lambda (a b) (apply 'mapcar (cons a b)))
    
40.                   '(min max)
    
41.                   (list l1 l2)
    
42.           )
    
43.   )
    
44.   (command
    
45.     "rectang"
    
46.     (trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
    
47.            0
    
48.            1
    
49.     )
    
50.     (trans (polar ur (* pi 0.25) d) 0 1)
    
51.   )
    
52. 
    
53. (command "CHPROP" "L" "" "LA" "PS_W" "");指定图层
    
54. (Setvar "osmode" osmode_bak);_还原捕捉
    
55. 
    
56. 
    
57. (setvar "CMDECHO" 1);_打开命令提示
    
58. 
    
59. 
    
60.   (princ)
    
61. )

(defun c:wk (/ ss i l1 l2 ll ur os d)<br />   (defun *MYERR* (MSG)<br /> (setvar "CMDECHO" CMD_OLD)<br /> (setvar "OSMODE" OS_OLD)<br /> (setq *ERROR* *OLDERR*)<br /> (if (= MSG "完美退出。谢谢使用。")<br />      (princ (strcat "\\n>>>" MSG))<br />      (princ "\n>>>虽然中途退出了，对象捕捉已经被恢复。")<br /> )<br /> (princ)<br />     )<br />     (setq *OLDERR* *ERROR*<br />    *ERROR*  *MYERR*<br />    OS_OLD   (getvar "OSMODE")<br />    CMD_OLD  (getvar "CMDECHO")<br />     )<br /> (setvar "CMDECHO" 0);_关闭命令提示<br /> (Setq osmode_bak (getvar "osmode"));_记录捕捉<br /> (Setvar "osmode" 0);_关闭捕捉<br /> <br /> (if *Scale* (setq d (getreal (strcat  "\n偏距<" (rtos *Scale* 2 2) ">:") ) )  (setq d (getreal  "\n偏<br /> <br /> 距:")))<br /> (if (null d) (setq d *Scale*) (setq *Scale*  d ))<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 /> <br /> (command "CHPROP" "L" "" "LA" "<img src="static/image/smiley/default/titter.gif" smilieid="9" border="0" alt="" />PS_W" "");指定图层<br /> (Setvar "osmode" osmode_bak);_还原捕捉<br /> <br /> <br /> (setvar "CMDECHO" 1);_打开命令提示<br /> <br /> <br />   (princ)<br /> )

飞雪神光

e719 发表于 2024-3-30 16:41
十分感谢，
不过不是很完美。
1，整数后是偏中心的我需要的是四边等距的

(defun c:wk (/ *error* cmd_old d d1 ename ent i l1 l2 ll ss ur)
  (defun *error* (msg)
                (setvar "cmdecho" cmd_old)
                (princ)
        )
        (setq cmd_old  (getvar "cmdecho"))
        (setvar "cmdecho" 0);_关闭命令提示
        (setq d 10)
        (while (setq ss (ssget '((8 . "~WK"))))
                (setq l1 nil)
                (setq l2 nil)
                (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)))
                (setq ll (list (- (car ll) d) (- (cadr ll) d)))
                (setq ur (list (+ (car ur) d) (+ (cadr ur) d)))
                (command
                        "rectang"
                        "non"
                        (trans ll 0 1)
                        "non"
                        (trans ur 0 1)
                )
                (setq ent (entget (setq ename (entlast))))
                (setq ent (subst (cons 8 "WK") (assoc 8 ent) ent))
                (entmod ent)
                (setvar "cmdecho" cmd_old)
        )
        (princ)
)

飞雪神光

(defun c:wk (/ *error* cmd_old d d1 ename ent i l1 l2 ll ss ur)
  (defun *error* (msg)
                (setvar "cmdecho" cmd_old)
                (princ)
        )
        (setq cmd_old  (getvar "cmdecho"))
        (setvar "cmdecho" 0);_关闭命令提示
        (setq d 10)
        (while (setq ss (ssget '((8 . "~WK"))))
                (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)))
                (setq ll (list (fix (car ll)) (fix (cadr ll))))
                (setq ur (list (fix (car ur)) (fix (cadr ur))))
                (command
                        "rectang"
                        "non"
                        (trans (polar ll (* pi 1.25) (setq d1 (sqrt (+ (* d d) (* d d))))) 0 1)
                        "non"
                        (trans (polar ur (* pi 0.25) d1) 0 1)
                )
                (setq ent (entget (setq ename (entlast))))
                (setq ent (subst (cons 8 "WK") (assoc 8 ent) ent))
                (entmod ent)
                (setvar "cmdecho" cmd_old)
        )
        (princ)
)

e719

飞雪神光 发表于 2024-3-30 13:11
(defun c:wk (/ *error* cmd_old d d1 ename ent i l1 l2 ll ss ur)
  (defun *error* (msg)
                (setvar ...

十分感谢，
不过不是很完美。
1，整数后是偏中心的我需要的是四边等距的


2，不是我想要的理想效果.

yefei812678