- 积分
- 2963
- 明经币
- 个
- 注册时间
- 2020-5-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 huxu823 于 2020-5-27 21:54 编辑
源码如下,求教怎么将默认的字体宽度0.8改为0.7?
此源码还有个BUG,如果当前选择的标注形式的全局比例不为1,就会影响引线标注的字体大小,还会导致线下的文字压线或者与线上文字重叠
如果能修复这个BUG就更完美了
;;; =================================================
;;; 动态引线标注 v2.0
;;; 带对话框,可设置参数,正交时自动对齐,基线随字长
;;; 作者:langjs 命令:yb 日期:2013年6月
;;; 增加线下文字功能 修改:孤帆 日期:2014年1月
;;; 修正ucs坐标下错误 支持引线自动对齐0,30,45,60,90度 文字居中
;;; 修改:wudechao 日期:2018年7月
;;; =================================================
(defun c:yb (/ #erryx001 $orr bb bi code data dcl_re dclname ent ent1 ent2 filen gr i lst n1 n2 n3 name1 name2 name3 nent pt pt0 ptlst
stream tempname tulst tulst1 tulst2 txlst txlst1 ty w w1 w2 x x0 x1 xunh y0 y1 pt0_w pt_w
)
(vl-load-com)
(defun #erryx001 (s)
(entdel name1)
(entdel name2)
(if name3 (entdel name3))
;(command ".UNDO" "E")
(setq *error* $orr)
); 按点表顺序更新多段线顶点,无须更换顶点用nil代替。by:langjs
(defun reent (ent ptlst / i nent x)
(setq i -1
nent '()
)
(foreach x ent
(setq nent (append
nent
(list (if (and
(= (car x) 10)
(/= (nth (setq i (1+ i))
ptlst
) nil
)
)
(cons 10 (nth i ptlst))
x
)
)
)
)
)
)
(defun relst (x i lst); 替换表中第i个元素。
(if (= 0 i)
(cons x (cdr lst))
(cons (car lst) (relst x (1- i) (cdr lst)))
)
)
(defun getty (ty / lst x); 图层列表
(setq x (tblnext ty t))
(while (/= x nil)
(setq lst (cons (cdr (assoc 2 x)) lst))
(setq x (tblnext ty))
)
(acad_strlsort lst)
)
(defun showlst (i lst); 显示列表
(start_list i)
(mapcar
'add_list
lst
)
(end_list)
)
(defun show ()
(setq n1 (getvar "CLAYER")
n2 (getvar "CLAYER")
n3 (getvar "TEXTSTYLE")
tulst1 (cons n1 (vl-remove n1 tulst))
tulst2 (cons n2 (vl-remove n2 tulst))
txlst1 (cons n3 (vl-remove n3 txlst))
lstsz (relst n1 6 lstsz)
lstsz (relst n2 7 lstsz)
lstsz (relst n3 8 lstsz)
lstsz (relst '("开" "关") 9 lstsz)
)
(setvar "orthomode" 1)
(showlst "e07" '("开" "关"))
(showlst "e10" tulst1)
(showlst "e11" tulst2)
(showlst "e12" txlst1)
(showlst "e13" (nth 9 lstsz))
)
(defun ybgetdata ()
(setq txt (get_tile "e01"))
(if (= (get_tile "a3") "0")
(setq kd3 0)
(setq kd3 1)
)
(if (= kd3 1)
(setq txt1 (get_tile "a2"))
)
)
(setvar "cmdecho" 0)
(setq $orr *error*)
(setq *error* #erryx001)
;(command ".UNDO" "BE")
(if (null txt1)
(setq txt1 "")
)
(if (null txt)
(setq txt "")
)
(while (/= bb 4)
(setq bi (getvar "DIMSCALE")
bb 3
xunh t
)
(if (null txt)
(setq txt "")
)
(if (null ptlast)
(setq ptlast (trans '(0.0 0.0) 1 0))
)
(if (null lstsz)
(setq lstsz (list (getvar "DIMTXT") (getvar "DIMCLRT") (getvar "DIMCLRD") (* 1.0 (getvar "DIMASZ")) (getvar "DIMEXO")
(cdr (assoc 41 (tblsearch "style" (getvar "TEXTSTYLE")))) (getvar "CLAYER") (getvar "CLAYER")
(getvar "TEXTSTYLE") '("开" "关") (* 0.0 (getvar "DIMASZ")) '("开" "关") '("箭头" "圆点")
)
)
)
(setq tulst (getty "LAYER")
txlst (getty "style")
n1 (nth 6 lstsz)
n2 (nth 7 lstsz)
n3 (nth 8 lstsz)
tulst1 (cons n1 (vl-remove n1 tulst))
tulst2 (cons n2 (vl-remove n2 tulst))
txlst1 (cons n3 (vl-remove n3 txlst))
)
(while (= bb 3)
(setq dclname (cond
((setq tempname (vl-filename-mktemp "yx.dcl")
filen (open tempname "w")
)
(foreach stream '("\n" "yx1:dialog {\n"
" label = \"引线标柱 2.0\" ;\n"
" :edit_box {key = \"e01\"; label = \"线上文字:\"; width = 40 ;}\n "
" :toggle {key = \"a3\"; label = \"增加线下文字\";}\n"
" :edit_box {key = \"a2\"; label = \"线下文字:\"; width = 40;}\n"
" :row { :button { key = \"e02\" ; label = \"确认\" ; is_default = true ; }\n"
" :button { key = \"e04\" ; label = \"设置\" ; } \n"
" :button { key = \"e03\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yx1" dcl_re))
(exit)
)
(set_tile "e01" txt)
(if (= kd3 1)
(progn
(set_tile "a3" "1")
(mode_tile "a2" 0)
(set_tile "a2" txt1)
)
(progn
(set_tile "a3" "0")
(mode_tile "a2" 1)
)
)
(action_tile "e02" "(ybgetdata)(done_dialog 1)")
(action_tile "e04" "(setq txt (get_tile \"e01\"))(done_dialog 2)")
(action_tile "e03" "(setq txt (get_tile \"e01\"))(done_dialog 4)")
(action_tile "a3" "(if (= (get_tile \"a3\") \"0\") (mode_tile \"a2\" 1) (progn (mode_tile \"a2\" 0)(set_tile \"a2\" txt1)))") ;点击时才起作用
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
(if (= bb 2)
(progn
(setq dclname (cond
((setq tempname (vl-filename-mktemp "yx.dcl")
filen (open tempname "w")
)
(foreach stream '("\n" "yx1:dialog {\n"
" label = \"引线标柱设置\" ;\n"
" :edit_box { label = \"文字高度\" ; key = \"e00\" ; }\n"
" :edit_box { label = \"宽度比例\" ; key = \"e08\" ; }\n"
" :edit_box { label = \"文字偏移\" ; key = \"e04\" ; }\n"
" :edit_box { label = \"文字颜色\" ; key = \"e01\" ; }\n"
" :edit_box { label = \"基线宽度\" ; key = \"e14\" ; }\n"
" :edit_box { label = \"箭头长度\" ; key = \"e03\" ; }\n"
" :edit_box { label = \"引线颜色\" ; key = \"e02\" ; }\n"
" :popup_list { label = \"线上递增\" ; key = \"e13\" ; }\n"
" :popup_list { label = \"线下递增\" ; key = \"e15\" ; }\n"
" :popup_list { label = \"正交对齐\" ; key = \"e07\" ; }\n"
" :popup_list { label = \"箭头形式\" ; key = \"e16\" ; }\n"
" :popup_list { label = \"文字样式\" ; key = \"e12\" ; }\n"
" :popup_list { label = \"文字图层\" ; key = \"e10\" ; }\n"
" :popup_list{ label = \"引线图层\" ; key = \"e11\" ; }\n"
" :row { :button { key = \"e05\" ; label = \"确认\" ; is_default = true ; }\n"
" :button { key = \"e09\" ; label = \"默认\" ; } \n"
" :button { key = \"e06\" ; label = \"取消\" ; is_cancel = true ; } } }\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yx1" dcl_re))
(exit)
)
(set_tile "e00" (rtos (nth 0 lstsz) 2 2))
(set_tile "e01" (itoa (nth 1 lstsz)))
(set_tile "e02" (itoa (nth 2 lstsz)))
(set_tile "e03" (rtos (nth 3 lstsz) 2 2))
(set_tile "e04" (rtos (nth 4 lstsz) 2 2))
(set_tile "e08" (rtos (nth 5 lstsz) 2 2))
(set_tile "e14" (rtos (nth 10 lstsz) 2 2))
(showlst "e10" tulst1)
(showlst "e11" tulst2)
(showlst "e12" txlst1)
(showlst "e13" (nth 9 lstsz))
(showlst "e15" (nth 11 lstsz))
(showlst "e16" (nth 12 lstsz))
(if (= (getvar "ORTHOMODE") 0)
(showlst "e07" '("关" "开"))
(showlst "e07" '("开" "关"))
)
(action_tile "e01" "(if (/=(setq c (acad_colordlg (nth 1 lstsz))) nil) (set_tile \"e01\" (itoa c) ))")
(action_tile "e02" "(if (/=(setq c (acad_colordlg (nth 2 lstsz))) nil) (set_tile \"e02\" (itoa c) ))")
(action_tile "e05" "(setq txlst1 (cons n3 (vl-remove n3 txlst))
tulst1 (cons n1 (vl-remove n1 tulst))
tulst2 (cons n2 (vl-remove n2 tulst))
lstsz (relst n1 6 lstsz)
lstsz (relst n2 7 lstsz)
lstsz (relst n3 8 lstsz)
lstsz (relst (atof (get_tile \"e14\"))10 lstsz)
lstsz (relst (atof (get_tile \"e00\")) 0 lstsz)
lstsz (relst (atoi (get_tile \"e01\")) 1 lstsz)
lstsz (relst (atoi (get_tile \"e02\")) 2 lstsz)
lstsz (relst (atof (get_tile \"e03\"))3 lstsz)
lstsz (relst (atof (get_tile \"e04\"))4 lstsz)
lstsz (relst (atof (get_tile \"e08\"))5 lstsz)
)
(done_dialog 3)")
(action_tile "e09" "(show)(set_tile \"e14\" (rtos (* 0.1 (getvar \"DIMASZ\")) 2 2))
(set_tile \"e00\" (rtos (getvar \"DIMTXT\") 2 2))
(set_tile \"e01\" (itoa (getvar \"DIMCLRT\")))
(set_tile \"e02\" (itoa (getvar \"DIMCLRD\")))
(set_tile \"e03\" (rtos (getvar \"DIMASZ\") 2 2))
(set_tile \"e04\" (rtos (getvar \"DIMEXO\") 2 2))
(set_tile \"e08\" (rtos (cdr (assoc 41 (tblsearch \"style\" (getvar \"TEXTSTYLE\")))) 2 2))")
(action_tile "e06" "(done_dialog 3)")
(action_tile "e10" "(setq n1 (nth (atoi $value ) tulst1)) ")
(action_tile "e11" "(setq n2 (nth (atoi $value ) tulst2)) ")
(action_tile "e12" "(setq n3 (nth (atoi $value ) txlst1)) ")
(action_tile "e07" "(setvar \"orthomode\" (rem (+ (getvar \"ORTHOMODE\") (atoi $value )) 2 )) (if (= (getvar \"ORTHOMODE\") 0)
(showlst \"e07\" '(\"关\" \"开\"))
(showlst \"e07\" '(\"开\" \"关\")))")
(action_tile "e13" "(if (= (atoi $value) 1) (setq lstsz (relst (reverse (nth 9 lstsz)) 9 lstsz))) (showlst \"e13\" (nth 9 lstsz)) ")
(action_tile "e15" "(if (= (atoi $value) 1) (setq lstsz (relst (reverse (nth 11 lstsz)) 11 lstsz))) (showlst \"e15\" (nth 11 lstsz)) ")
(action_tile "e16" "(if (= (atoi $value) 1) (setq lstsz (relst (reverse (nth 12 lstsz)) 12 lstsz))) (showlst \"e16\" (nth 12 lstsz)) ")
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
)
)
)
(if (= bb 1)
(if (setq pt0 (getpoint "\n命令:_yb 指定第一点:"))
(progn
(setq pt0_w (trans pt0 1 0));转为wcs的点
(princ (strcat "\n指定下一点:"))
(cond
((= (car (nth 12 lstsz)) "圆点")
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (nth 7 lstsz)) (cons 62 (nth 2 lstsz)) '(100 . "AcDbPolyline")
(cons 90 6) (cons 10 (trans (list (- (car pt0) (* 0.25 bi (nth 3 lstsz))) (cadr pt0)) 1 0))
(cons 40 (* 0.5 bi (nth 3 lstsz))) (cons 41 (* 0.5 bi (nth 3 lstsz))) '(42 . 1.0)
(cons 10 (trans (list (+ (car pt0) (* 0.25 bi (nth 3 lstsz))) (cadr pt0)) 1 0)) (cons 40 (* 0.5 bi (nth 3 lstsz))) (cons 41 (* 0.5 bi (nth 3 lstsz))) '(42 . 1.0)
(cons 10 (trans (list (- (car pt0) (* 0.25 bi (nth 3 lstsz))) (cadr pt0)) 1 0)) '(40 . 0) '(41 . 0) '(42 . 0)
(cons 10 pt0_w) '(40 . 0) '(41 . 0) '(42 . 0) (cons 10 pt0_w) (cons 40 (* bi (nth 10 lstsz))) (cons 41 (* bi (nth 10 lstsz)))
(cons 10 pt0_w)
)
)
)
((= (car (nth 12 lstsz)) "箭头")
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (nth 7 lstsz)) (cons 62 (nth 2 lstsz)) '(100 . "AcDbPolyline")
(cons 90 4) (cons 10 pt0_w) '(40 . 0.0) (cons 41 (* 0.3 bi (nth 3 lstsz))) (cons 10 pt0_w)
(cons 10 pt0_w) (cons 40 (* bi (nth 10 lstsz))) (cons 41 (* bi (nth 10 lstsz))) (cons 10 pt0_w)
)
)
)
)
(setq ent1 (entget (setq name1 (entlast))))
(setq tr-angle (angle '(0 0 0) (getvar "ucsxdir")));ucs坐标角度,转为wcs的角度
(entmake (list '(0 . "TEXT") (cons 8 (nth 6 lstsz)) '(72 . 1) '(73 . 1) (cons 62 (nth 1 lstsz)) (cons 1 txt) (cons 10 pt0_w)
(cons 40 (* bi (nth 0 lstsz))) (cons 41 (nth 5 lstsz)) (cons 7 (nth 8 lstsz)) (cons 50 tr-angle)
)
)
(setq ent2 (entget (setq name2 (entlast)))
w (caadr (textbox ent2))
)
(if (= kd3 1)
(progn
(setq tr-angle (angle '(0 0 0) (getvar "ucsxdir")));ucs坐标角度,转为wcs的角度
(entmake (list '(0 . "TEXT") (cons 8 (nth 6 lstsz)) '(72 . 1) '(73 . 1) (cons 62 (nth 1 lstsz)) (cons 1 txt1) (cons 10 (trans (polar pt0 (* 1.5 pi)(* 1.5(nth 0 lstsz))) 1 0))
(cons 40 (* bi (nth 0 lstsz))) (cons 41 (nth 5 lstsz)) (cons 7 (nth 8 lstsz)) (cons 50 tr-angle)
)
)
(setq ent3 (entget (setq name3 (entlast)))
w1 (caadr (textbox ent3))
)
)
)
(while (progn
(setq gr (grread t 15 0)
code (car gr)
data (cadr gr)
)
(cond
((= code 2); 键盘区域
(redraw)
(if (= data 15)
(if (= (getvar "ORTHOMODE") 0)
(progn
(prompt "\n命令: <正交 开>")
(setvar "orthomode" 1)
)
(progn
(prompt "\n命令: <正交 关>")
(setvar "orthomode" 0)
)
)
)
)
((= code 3); 鼠标左击
(setq ptlast pt
xunh nil
)
(setq ptlast (trans ptlast 1 0));转为wcs的点
)
((= code 5); 鼠标移动
(if (= (getvar "ORTHOMODE") 1)
(progn
(setq ang1 (angle pt0 data))
(setq ang1 (rem ang1 (* 2 pi)));对360度取余
(if (or;以下代码控制引线固定角度
(<= ang1 0.261799);15度
(> ang1 6.021386);345度
);_ 结束and
(setq ang1 0)
);_ 结束if
(if (and
(> ang1 0.261799);15度
(<= ang1 0.654498);37.5度
);_ 结束and
(setq ang1 (/ pi 6))
);_ 结束if
(if (and
(> ang1 0.654498);37.5度
(<= ang1 0.916298);52.5度
);_ 结束and
(setq ang1 (* 0.25 pi))
);_ 结束if
(if (and
(> ang1 0.916298);52.5度
(<= ang1 1.308997);75度
);_ 结束and
(setq ang1 (/ pi 3))
);_ 结束if
(if (and
(> ang1 1.308997);75度
(<= ang1 1.832596);105度
);_ 结束and
(setq ang1 (/ pi 2))
);_ 结束if
(if (and
(> ang1 1.832596);105度
(<= ang1 2.225295);127.5度
);_ 结束and
(setq ang1 (* 2 (/ pi 3)))
);_ 结束if
(if (and
(> ang1 2.225295);127.5度
(<= ang1 2.487094);142.5度
);_ 结束and
(setq ang1 (* 3 (/ pi 4)))
);_ 结束if
(if (and
(> ang1 2.487094);142.5度
(<= ang1 2.879793);165度
);_ 结束and
(setq ang1 (* 5 (/ pi 6)))
);_ 结束if
(if (and
(> ang1 2.879793);165度
(<= ang1 3.403392);195度
);_ 结束and
(setq ang1 pi)
);_ 结束if
(if (and
(> ang1 3.403392);195度
(<= ang1 3.796091);217.5度
);_ 结束and
(setq ang1 (* 7 (/ pi 6)))
);_ 结束if
(if (and
(> ang1 3.796091);217.5度
(<= ang1 4.057891);232.5度
);_ 结束and
(setq ang1 (* 5 (/ pi 4)))
);_ 结束if
(if (and
(> ang1 4.057891);232.5度
(<= ang1 4.450590);255度
);_ 结束and
(setq ang1 (* 4 (/ pi 3)))
);_ 结束if
(if (and
(> ang1 4.450590);255度
(<= ang1 4.974188);285度
);_ 结束and
(setq ang1 (* 3 (/ pi 2)))
);_ 结束if
(if (and
(> ang1 4.974188);285度
(<= ang1 5.366887);307.5度
);_ 结束and
(setq ang1 (* 5 (/ pi 3)))
);_ 结束if
(if (and
(> ang1 5.366887);307.5度
(<= ang1 5.628687);322.5度
);_ 结束and
(setq ang1 (* 7 (/ pi 4)))
);_ 结束if
(if (and
(> ang1 5.628687);322.5度
(<= ang1 6.021386);345度
);_ 结束and
(setq ang1 (* 11 (/ pi 6)))
);_ 结束if
(setq pt (polar pt0 ang1 (distance pt0 data)))
)
(setq pt data)
)
(setq pt_w (trans pt 1 0));转为wcs的点
(if (= kd3 1) (setq w2 (/ (max w w1) 2)) (setq w2 (/ w 2)))
(cond
((= (car (nth 12 lstsz)) "圆点")
(entmod (reent ent1 (list nil nil nil nil pt_w (trans (polar pt (if (>= (car pt) (car pt0))
0
pi
) (if (= kd3 1) (max w w1)w)
) 1 0
)
)
)
)
)
((= (car (nth 12 lstsz)) "箭头")
(entmod (reent ent1 (list nil (trans (polar pt0 (angle pt0 pt) (* bi (nth 3 lstsz))) 1 0) pt_w
(trans (polar pt (if (>= (car pt) (car pt0))
0
pi
) (if (= kd3 1) (max w w1)w)
) 1 0
)
)
)
)
)
)
(entmod (subst
(cons 11 (trans (list (if (>= (car pt) (car pt0))
(+ (car pt) w2)
(- (car pt) w2)
)
(+ (cadr pt) (* bi (nth 4 lstsz)))
) 1 0
)
)
(assoc 11 ent2)
ent2
)
)
(if (= kd3 1)
(entmod (subst
(cons 11 (trans (list (if (>= (car pt) (car pt0))
(+ (car pt) w2)
(- (car pt) w2)
)
(- (cadr pt) (* bi (nth 4 lstsz)) (nth 0 lstsz))
) 1 0
)
)
(assoc 11 ent3)
ent3
)
)
)
(redraw)
)
((or
(= code 11)
(= code 25)
) ; 鼠标右击
(if (and
(wcmatch txt "~*[~.0-9]*")
(= (car (nth 9 lstsz)) "开")
)
(setq txt (itoa (1- (atoi txt))))
)
(if (and
(wcmatch txt1 "~*[~.0-9]*")
(= (car (nth 11 lstsz)) "开")
)
(setq txt1 (itoa (1- (atoi txt1))))
)
(entdel name1)
(entdel name2)
(if name3 (entdel name3))
(setq xunh nil)
(redraw)
)
(t
)
)
xunh
)
)
(if (and
(wcmatch txt "~*[~.0-9]*")
(= (car (nth 9 lstsz)) "开")
)
(setq txt (itoa (1+ (atoi txt))))
)
(if (and
(wcmatch txt1 "~*[~.0-9]*")
(= (car (nth 11 lstsz)) "开")
(= kd3 1)
)
(setq txt1 (itoa (1+ (atoi txt1))))
)
)
)
)
)
;(command ".UNDO" "E")
(setq *error* $orr)
(setvar "cmdecho" 1)
(princ)
)
|
|