引线标注程序改进
本帖最后由 s678z 于 2013-12-18 08:52 编辑附件lisp程序要求改进，
程序“单件引线标注.lsp”,是按图框放大系数，标注的序号字体及字体下面
横线自动放大，适合图框放大的模式，随鼠标移动方向序号可向左、右标注，
但该程序不能标注向上和水平方向的连续序号。
程序“自动编号XH.VLX”可以连续向上和水平方向标注，但只有一个方向
，不能按图框放大调整字体及横线大小。
要求把程序“单件引线标注.lsp”参考“自动编号XH.VLX”程序功能，增加连
续向上和水平方向标注，水平方向要有左右两个方向，见附图，其余参数按“单
件引线标注.lsp”程序不变。
命名与程序不一样，应该称为引线标注 ;;;连续编号
(defun c:bh (/ oce1 qz n1 zn h1 sxh1 p1)
(setq oce1 (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "-style" "BG_ST" "宋体" 0 0.8 0 "n" "n")
(setq p1 (getpoint "\n请指定插入点: "))
(setq qz (getstring "\n请输入前缀相同的部分: "))
(if (not (setq n1 (getint "\n请输入起始顺序号 <1>: ")))
(setq n1 1)
)
(if (not (setq zn (getint "\n请输入增加或减少的序数 <+1>: ")))
(setq zn 1)
)
(if (not (setq h1 (getreal "\n请指定文字高度 <2.5>: ")))
(setq h1 2.5)
)
(setq sxh1 (strcat qz (itoa n1)))
(while (/= p1 nil)
(command "text" "m" p1 h1 0 sxh1)
(setq
n1 (+ n1 zn)
sxh1 (strcat qz (itoa n1))
p1 (getpoint "\n请指定下一插入点: ")
)
)
(setvar "cmdecho" oce1)
(princ)
) (defun c:tt (/ ll p1 p2 p3 rad tx p4)
(if (null sc)
(setq sc (getreal "\n比例: "))
)
(xyp-MkLaCo "文字标注层" 3)
(setq txt (Uint 7 "" "序号" txt)
ll(* 7 sc)
)
(while (and (setvar "OSMODE" 0)
(setq p1 (getpoint "\n起点: "))
(setvar "OSMODE" 512)
(setq p2 (getpoint p1 "\n第二点: "))
(setvar "OSMODE" 0)
(setq p3 (getpoint p2 "\n方向点: "))
)
(setq rad (angle p2 p3)
tx(itoa txt)
)
(if (< (/ pi 2) rad (* 1.5 pi))
(setq p4 (polar p2 2.737 (* 3.5 sc))
p3 (polar p2 pi ll)
)
(setq p4 (polar p2 0.4 (* 3.5 sc))
p3 (polar p2 0 ll)
)
)
(command "pline" p1 p2 p3 "")
(command "text" "j" "bc" p4 (* 5 sc) 0 tx)
(setq txt (1+ txt))
)
(setvar "OSMODE" 167)
(princ)
) 此帖子应为悬赏，搞错了，请版主把它删了，因为没法转为悬赏，我已另发http://bbs.mjtd.com/thread-108746-1-1.html
页:
[1]