Question

visual lisp写一个小程序 就在cad中画一个矩形 可以自由改动长宽高 先谢谢 了

Answer 1

;试用以下程序
(defun c:ccc()
(setq cm (getvar "cmdecho")
os (getvar "osmode")
)
(setvar "cmdecho" 0)
(command "_undo" "be")

(if (setq pt0 (getpoint "\左下角:"))
(if (setq pt1 (getcorner pt0 "\n右上角:"))
(progn
(setvar "osmode" 0)
(command "_rectang" pt0 pt1)
(while (setq pdbz (getint "\n要改变长宽吗<输入任意整数则改变，回车则结束>:"))
(setq dxy (mapcar '- pt1 pt0)
ent (entlast)
)
(if (= (setq cd (getreal (strcat "\n当前长度为:" (rtos (car dxy) 2 3) ", 请输入改动值:"))) nil)
(setq cd (car dxy))
)
(if (= (setq kd (getreal (strcat "\n当前宽度为:" (rtos (cadr dxy) 2 3) ", 请输入改动值:"))) nil)
(setq kd (cadr dxy))
)
(if (not (equal dxy (list cd kd)))
(command "_erase" ent ""
"_rectang" pt0 (mapcar '+ pt0 (list cd kd))
)
)
)
)
)
)

(command "_undo" "e")
(setvar "osmode" os)
(setvar "cmdecho" cm)
(princ)
)

追问

在这个基础上能不能可以选择任何填充图案进行填充

追答

可以，以下程序未加入对填充图案名是否存在的判断
;试用以下程序
(defun c:ccc()
(setq cm (getvar "cmdecho")
os (getvar "osmode")
)
(setvar "cmdecho" 0)
(command "_undo" "be")

(if (setq pt0 (getpoint "\左下角:"))
(if (setq pt1 (getcorner pt0 "\n右上角:"))
(progn
(setvar "osmode" 0)
(command "_rectang" pt0 pt1)
(while (setq pdbz (getint "\n要改变长宽吗:"))
(setq dxy (mapcar '- pt1 pt0)
ent (entlast)
)
(if (= (setq cd (getreal (strcat "\n当前长度为:" (rtos (car dxy) 2 3) ", 请输入改动值:"))) nil)
(setq cd (car dxy))
)
(if (= (setq kd (getreal (strcat "\n当前宽度为:" (rtos (cadr dxy) 2 3) ", 请输入改动值:"))) nil)
(setq kd (cadr dxy))
)
(if (not (equal dxy (list cd kd)))
(command "_erase" ent ""
"_rectang" pt0 (mapcar '+ pt0 (list cd kd))
)
)
)
(if (= (setq tam (getstring "\n输入图案名:")) "")
(setq tam "ANGLE")
)
(if (= tam "SOLID")
(command "_hatch" tam (entlast) "")
(command "_hatch" "ANGLE" "" "" (entlast) "")
)
)
)
)

(command "_undo" "e")
(setvar "osmode" os)
(setvar "cmdecho" cm)
(princ)
)

Answer 2

怎么个改法？