[源码] 导线型号及档距标注
(defun C:bzdj(/)(prompt "\n请选择多段线进行标注")
(setq dotlen (getint " \n请输入小数位数(直接跳过默认为0):"))
(setq texthigh (getreal " \n请输入字高(直接跳过默认为3):"))
(setq textcolor (getint " \n请输入颜色代码(直接跳过默认为3[绿色]):"))
(if (= nil dotlen) (setq dotlen 0))
(if (= nil texthigh) (setq texthigh 3))
(if (= nil textcolor) (setq textcolor 3))
(dxbz "m" texthigh textcolor dotlen)
)
(defun C:bzxh(/)
(prompt "\n请选择多段线进行标注")
(setq linename (getstring " \n请输入导线型号(直接跳过默认为LGJ-25)："))
(setq texthigh (getreal " \n请输入字高(直接跳过默认为3):"))
(setq textcolor (getint " \n请输入颜色代码(直接跳过默认为3[绿色]):"))
(if (= "" linename) (setq linename "LGJ-25"))
(if (= nil texthigh) (setq texthigh 3))
(if (= nil textcolor) (setq textcolor 3))
(dxbz linename texthigh textcolor 0)
)
(defun dxbz (text texthigh textcolor dotlen / ent lis);多段线每段线中心标注本段线长
(setq sset nil)
(while (equal sset nil)
(setq sset (ssget (list
(cons 0 "LWPOLYLINE" )
;(cons 62 7 );过滤条件颜色为白色
)))
)
;(setq FontStyle (GetFontStyle "XX-宋体"))
(setq FontStyle "XX-宋体")
(setq i -1)
(while (setq ent (ssname sset (setq i (1+ i))))
(mapcar '
(lambda (x)
(if (= "m" text) (setq textvalue (strcat (car x) "m")) (setq textvalue linename))
(if (> (atof (car x)) 5.0)
(entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText")
(cons 7 FontStyle)
(cons 1 textvalue)
(cons 10
(polar (cadr x) (+ (last x) (*(if (= "m" text) -1 1) (/ pi 2))) (/ texthigh 2)))
(cons 71 (if (= "m" text) 2 8))
(cons 62 textcolor)
(cons 40 texthigh)
(cons 11 (cadr x))
(cons 50 (last x))))
)
)
(mapcar '
(lambda (x)
(list
(rtos (distance (car x) (cadr x)) 2 dotlen)
(mapcar '* '(0.5 0.5) (mapcar '+ (car x) (cadr x)))
(angle (car x) (cadr x))
;(- (rem (+ (angle (car x) (cadr x)) (* 0.25 pi)) pi) (* 0.25 pi))
))
(mapcar 'list (setq lis (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget ent)))) (cdr lis))
))
(princ)
)
)
页:
[1]