CAD洞口自动标注程序

(defun C:dk1(/ pt dis dong qt x1 x2 y1 y2 dx dy pt1 pt2 pt3 pt4
ptt1 ptt2 dxx dyy dxt dyt ptt lay txt dxh dyh pth) (setvar "CMDECHO" 0)
(setq lay (getvar "clayer"))
(command "color" "bylayer")
(command "layer" "m" "dk" "c" "m" "dk" "")
(if (or (= nil (tblsearch "style" "hz"))
(/= (cdr (assoc 40 (tblsearch "style" "hz"))) 0) )
(command "STYLE" "hz" "txt,hztxt" "0" ".8" "0" "n" "n" "n") )
(command "osnap" "int")
(setq pt (getpoint "\n请输入参考点(左上角墙线交点):")) (command "osnap" "non")
(initget 1)
(setq dis (getreal "\n距参考点距离(mm):"))
(initget 7)
(setq dong (getreal "\n洞口宽度(mm):"))
(initget 7)
(setq qt (getreal "\n墙体厚度(mm):"))
(setq dy (cadr pt))
(setq dx (car pt))
(setq x1 (+ dx (/ dis 100)))
(setq x2 (+ x1 (/ dong 100)))
(setq y1 dy)
(setq y2 (+ y1 (/ qt 100)))
(setq pt1 (list x1 y1))
(setq pt2 (list x1 y2))
(setq pt3 (list x2 y2))
(setq pt4 (list x2 y1))
(command "pline" pt1 "w" "0" "0" pt2 pt3 pt4 "c") (command "hatch" "ansi31" "9" "0" "last" "")
(setq ptt1 (getpoint "\n洞口标注线第一点:"))
(setq ptt2 (getpoint ptt1 "\n洞口标注线第二点:")) (command "pline" ptt1 ptt2 "@10,0" "")
(setq dxx (car ptt2))
(setq dyy (cadr ptt2))
(setq dxt (+ dxx 1))
(setq dyt (+ dyy 0.65))
(setq ptt (list dxt dyt))
(command "text" "s" "hz" ptt "5" "0" "洞")
(setq txt (getreal "\n洞口号:"))
(setq dxh (+ dxt 5))
(setq dyh (+ dyt 0.5))
(setq pth (list dxh dyh))
(setq txt1 (rtos txt 2 0)) (command "text" pth "4" "0" txt1) (command "layer" "s" lay "") (princ)(princ)
)。