麻烦帮忙在这个代码加一个循环
本帖最后由 e719 于 2024-3-30 09:57 编辑我加了一个，它循环时吧前面加的框也加进去了，麻烦各位大神帮我加一个，最好把外形做个整数和把距离变成默认的。谢谢~:lol
(defun c:wk (/ ss i l1 l2 ll ur os d)
(defun *MYERR* (MSG)
(setvar "CMDECHO" CMD_OLD)
(setvar "OSMODE" OS_OLD)
(setq *ERROR* *OLDERR*)
(if (= MSG "完美退出。谢谢使用。")
(princ (strcat "\\n>>>" MSG))
(princ "\n>>>虽然中途退出了，对象捕捉已经被恢复。")
)
(princ)
)
(setq *OLDERR* *ERROR*
*ERROR**MYERR*
OS_OLD (getvar "OSMODE")
CMD_OLD(getvar "CMDECHO")
)
(setvar "CMDECHO" 0);_关闭命令提示
(Setq osmode_bak (getvar "osmode"));_记录捕捉
(Setvar "osmode" 0);_关闭捕捉
(if *Scale* (setq d (getreal (strcat"\n偏距<" (rtos *Scale* 2 2) ">:") ) )(setq d (getreal"\n偏
距:")))
(if (null d) (setq d *Scale*) (setq *Scale*d ))
(setq ss (ssget))
(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"
(trans (polar ll (* pi 1.25) (setq d (sqrt (+ (* d d) (* d d)))))
0
1
)
(trans (polar ur (* pi 0.25) d) 0 1)
)
(command "CHPROP" "L" "" "LA" "PPS_W" "");指定图层
(Setvar "osmode" osmode_bak);_还原捕捉
(setvar "CMDECHO" 1);_打开命令提示
(princ)
)
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)
)
本帖最后由 飞雪神光 于 2024-3-30 13:14 编辑
(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)
)
飞雪神光 发表于 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，不是我想要的理想效果.
{:1_1:}{:1_1:}{:1_1:}{:1_1:}{:1_1:}
页:
[1]