求高手帮实现一简单功能
画线标注板标高， 并使标高尺寸与直线平行。如图：;;画线标高绘制主程序
;;code by edta 2014-7-28 @mjtd.com
;;命令bg2
(defun c:bg2(/ p1 p2 sk_level_s ang p3)
(vl-load-com)
(vla-StartUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(setq *error*_Old *error*) ;保存出错处理函数
(setq *error* *error*_New)
(or sk_scale (setq sk_scale(cond((getint (strcat "\n输入标高比例<100>: ")))(100))))
(or sk_level (setq sk_level 0.000))
(setq bak_dimzin(getvar 'dimzin))
(setvar 'dimzin 0)
(if(and(setq sk_level(cond((getreal (strcat "\n输入标高值<"(rtos sk_level 2 3)">:")))(sk_level)))
(list t (initget "s _s"))
(setq p1(getpoint (strcat "\n指定第一点/(S)标高比例<" (itoa sk_scale) ">:")))
(if (= p1 "s")
(progn
(setq sk_scale(cond((getint (strcat "\n输入标高比例<"(itoa sk_scale)">: ")))(sk_scale)))
(setq p1(getpoint (strcat "\n指定第一点,当前标高比例<"(itoa sk_scale)">: "))))
t
)
(setq p2(getpoint p1 "\n指定第二点:"))
)
(progn
(if(equal sk_level 0.000)
(setq sk_level_s "%%P0.000")
(setq sk_level_s (rtos sk_level 2 3))
)
(setq ang(angle p1 p2))
(if (and (>= ang (* pi 0.5))(<= ang (* pi 1.5)))
(setq p3 p1 p1 p2 p2 p3))
(sk_mk_level p1 p2 sk_level_s sk_scale)
(entmake (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
)
)
(and bak_dimzin(setvar 'dimzin bak_dimzin))
(and *error*_Old(setq *error* *error*_Old))
(vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
;;标高生成函数
(defun sk_mk_level(p1 p2 sk_level sk_scale / ang lst mpt mpt1 p4 pt pt1 pt3 pt4 pt5 pt6)
(setq mpt(mapcar '(lambda(x y)(* 0.5 (+ x y))) p1 p2)
ang(angle p1 p2)
mpt1(polar mpt (+ ang (* 0.5 pi)) (* 3 sk_scale))
pt1(polar mpt1 ang (* 3 sk_scale))
pt3(polar mpt1 ang (* -3 sk_scale))
pt4(polar mpt1 ang (* 15 sk_scale))
pt5(polar mpt1 ang (* 9 sk_scale))
lst (list pt1 mpt pt3 pt4)
)
(entmake (append
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst)))
(mapcar '(lambda (pt)(cons 10 pt)) lst ))
)
(entmake (list '(0 . "TEXT")
(cons 1 sk_level)
(cons 73 1)
(cons 72 1)
(cons 10 pt4)
(cons 11 pt5)
(cons 40 (* sk_scale 2.5))
(cons 50 ang))
)
)
;;出错处理函数
(defun *error*_New (msg)
(and *error*_Old(setq *error* *error*_Old))
(and bak_dimzin(setvar 'dimzin bak_dimzin))
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
(if (= (getvar "LOCALE") "CHS")
(princ "\n用户按了<Esc>强制退出")
(princ "\nYou cancelled The operation!")
)
(princ (strcat "\n" msg))
)
(vla-EndUndoMark(vla-get-ActiveDocument (vlax-get-acad-object)))
(princ)
)
(vl-load-com)
(prompt "\n画线标高 命令bg2")
(princ) 十分感谢 收益良多
页:
[1]