BG4标高自动标注4下右.LSP
资源名称:cadlisp1.rar [点击查看]
上传用户:sd555111
上传日期:2014-05-17
资源大小:31k
文件大小:2k
源码类别:
CAD
开发平台:
MathCAD
- ; =============================================
- ; | 标高自动标注软件 |
- ; | 版本: V1.1 作者: 尉迟俊岭 |
- ; =============================================
- (defun C:bg4(/ dx dy dx1 dx2 dx3 dy1 pt dxt dyt
- lay pt1 pt2 pt3 pt4 pt5 ptt scale)
- (setvar "CMDECHO" 0)
- (setq lay (getvar "clayer"))
- (command "color" "bylayer")
- (command "layer" "m" "bg" "c" "yellow" "bg" "")
- (if (or (= nil (tblsearch "style" "xw"))
- (/= (cdr (assoc 40 (tblsearch "style" "xw"))) 0)
- )
- (command "STYLE" "xw" "txt" "0" ".8" "0" "n" "n" "n")
- )
- (if (= scab nil) (setq scab 1.0))
- (setq scale (getreal (strcat "n等比缩放值 <" (rtos scab 2 0) ">:")))
- (if (= scale nil) (setq scale scab))
- (setq scab scale)
- (setvar "osmode" 512)
- (setq pt (getpoint "n指定插入点 <nea mode>: "))
- (setvar "osmode" 0)
- (setq dy (cadr pt))
- (setq dx (car pt))
- (setq dx1 (- dx (* 3 scale)))
- (setq dx2 (+ dx (* 3 scale)))
- (setq pt1 (list dx1 dy))
- (setq pt2 (list dx2 dy))
- (command "line" pt1 pt2 "")
- (setq dy1 (- dy (* 3 scale)))
- (setq pt3 (list dx1 dy1))
- (command "line" pt pt3 "")
- (setq pt4 (list dx2 dy1))
- (command "line" pt pt4 "")
- (setq dx3 (- dx (* 13 scale)))
- (setq pt5 (list dx3 dy1))
- (command "line" pt4 pt5 "")
- (setq dxt (+ dx3 (* 2 scale)))
- (setq dyt (- dy1 (* 4.15 scale)))
- (setq txt 0)
- (setq high (* 3 scale))
- (while (/= txt nil)
- (setq txt (getreal "n标注文字说明:"))
- (if (/= txt nil)
- (progn
- (setq ptt (list dxt dyt))
- (setq txt1 (rtos txt 2 3))
- (command "text" "s" "xw" ptt high "0" txt1)
- (setq dyt (- dyt (* 4.15 scale)))
- )
- )
- )
- (command "layer" "s" lay "")
- (princ)(princ)
- )