求救高手增加动态标注中文字样式
;;;=================================================;;; 动态引线标注 v2.0
;;; 带对话框，可设置参数，正交时自动对齐，基线随字长
;;; 作者：langjs 命令:yx 日期:2013年6月
;;;=================================================
;;; 修改：peace
;;; 增加文字图层、引线图层及出图比例选项
;;; 增加保存变量至文本的功能
;;;=================================================
(defun c:DYinXian (/ #erryx001 $orr bb bi code data dcl_re dclname ent ent1 ent2 filen gr i lst name1 name2 nent pt pt0 ptlst stream
tempname w x x0 x1 xunh y0 y1
)
(defun #erryx001 (s)
(entdel name1)
(entdel name2)
(command ".UNDO" "E")
(setq *error* $orr)
)
;函数区域开始===============
;保存peace系统变量，保存到cad安装目录下的PEACESYSVAL.TXT by PEACE 2013/05/25
(defun PEACE:SaveSysVarPeace(valname valvalue infotext / acadpath f datalist data valvalue_old i isthere)
(setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
(if (= infotext "")(setq infotext "no infotext"))
(if (null (findfile "PEACESYSVAL.TXT"))
(progn ;若文件不存在
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
(prin1 (list valname valvalue infotext) f)
(close f)
)
(progn ;若文件已存在
(setq datalist '())
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
(while (setq data (read-line f))
(setq datalist (cons data datalist))
)
(close f)
(setq datalist (reverse datalist))
(setq i 0
isthere 0)
(repeat (length datalist)
(if (= valname (car (read (nth i datalist))))
(progn
(setq datalist (subst (vl-prin1-to-string (list valname valvalue infotext)) (nth i datalist) datalist))
(setq isthere 1)
)
)
(setq i (1+ i))
)
(if (= 1 isthere)
(progn
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "w"))
(prin1 (read (nth 0 datalist)) f)
(close f)
(setq i 1)
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
(repeat (- (length datalist) 1)
(write-line "" f)
(prin1 (read (nth i datalist)) f)
(setq i (1+ i))
)
(close f)
)
(progn
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "a"))
(write-line "" f)
(prin1 (list valname valvalue infotext) f)
(close f)
)
)
)
)
(princ)
)
;读取peace系统变量 by PEACE 2013/05/25
(defun PEACE:ReadSysVarPeace( / acadpath data datalist i f)
(setq acadpath(vlax-get-property (vlax-get-acad-object) 'Path))
(if (findfile "PEACESYSVAL.TXT")
(progn
(setq datalist '())
(setq f (open (strcat acadpath "\\PEACESYSVAL.TXT") "r"))
(while (setq data (read-line f))
(setq datalist (cons data datalist))
)
(reverse datalist)
(close f)
(setq i 0)
(repeat (length datalist)
(set (read (car (read (nth i datalist)))) ;注意字符和表之间的转换，字符串是不能作为变量名的
(cadr (read (nth i datalist))) ;car对字符串也是不起作用的
)
(setq i (1+ i))
)
)
nil
)
)
; 按点表顺序更新多段线顶点,无须更换的顶点用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
)
)
)
)
)
)
; 替换表中第i个元素。
(defun relst (x i lst)
(if (= 0 i)
(cons x (cdr lst))
(cons (car lst) (relst x (1- i) (cdr lst)))
)
)
(defun SaveSysVar()
(PEACE:SaveSysVarPeace "PEACE:YX_Txt" PEACE:YX_Txt "YX文字")
(PEACE:SaveSysVarPeace "PEACE:YX_TextH" PEACE:YX_TextH "YX文字高度")
(PEACE:SaveSysVarPeace "PEACE:YX_TextW2H" PEACE:YX_TextW2H "YX文字宽高比")
(PEACE:SaveSysVarPeace "PEACE:YX_TextS" PEACE:YX_TextS "YX文字样式")
(PEACE:SaveSysVarPeace "PEACE:YX_TextD" PEACE:YX_TextD "YX文字偏移")
(PEACE:SaveSysVarPeace "PEACE:YX_TextColor" PEACE:YX_TextColor "YX文字颜色")
(PEACE:SaveSysVarPeace "PEACE:YX_TextLayer" PEACE:YX_TextLayer "YX文字图层")
(PEACE:SaveSysVarPeace "PEACE:YX_DIML" PEACE:YX_DIML "YX箭头长度")
(PEACE:SaveSysVarPeace "PEACE:YX_DIMColor" PEACE:YX_DIMColor "YX引线颜色")
(PEACE:SaveSysVarPeace "PEACE:YX_DIMLayer" PEACE:YX_DIMLayer "YX引线图层")
(PEACE:SaveSysVarPeace "PEACE:YX_Ratio" PEACE:YX_Ratio "YX出图比例")
)
(defun GETDATA()
(setq PEACE:YX_TextH (atof (get_tile "e00"))
PEACE:YX_TextColor (atoi (get_tile "e01"))
PEACE:YX_DIMColor (atoi (get_tile "e02"))
PEACE:YX_DIML (atof (get_tile "e03"))
PEACE:YX_TextD (atof (get_tile "e04"))
PEACE:YX_TextW2H (atof (get_tile "e08"))
PEACE:YX_TextLayer (get_tile "e10")
PEACE:YX_DIMLayer (get_tile "e11")
PEACE:YX_Ratio (atof (get_tile "e12"))
bi (/ PEACE:YX_Ratio 100)
)
)
;局部函数结束=====
(PEACE:ReadSysVarPeace)
(setvar "cmdecho" 0)
(setq $orr *error*)
(setq *error* #erryx001)
(command ".UNDO" "BE")
(if (not PEACE:YX_Txt)(setq PEACE:YX_Txt ""));文字高度
(if (not PEACE:YX_TextH)(setq PEACE:YX_TextH (getvar "DIMTXT")));文字高度
(if (not PEACE:YX_TextW2H)(setq PEACE:YX_TextW2H (cdr (assoc 41 (tblsearch "style" (getvar "TEXTSTYLE"))))));文字宽高比
(if (not PEACE:YX_TextD)(setq PEACE:YX_TextD (getvar "DIMEXO")));文字偏移
(if (not PEACE:YX_TextColor)(setq PEACE:YX_TextColor (getvar "DIMCLRT")));文字颜色
(if (or (not PEACE:YX_TextLayer)(= "" PEACE:YX_TextLayer)) (setq PEACE:YX_TextLayer "J-TEXT"));文字图层
(if (not PEACE:YX_DIML)(setq PEACE:YX_DIML (getvar "DIMASZ")));箭头长度
(if (not PEACE:YX_DIMColor)(setq PEACE:YX_DIMColor (getvar "DIMCLRD")));引线颜色
(if (or (not PEACE:YX_DIMLayer)(= "" PEACE:YX_DIMLayer)) (setq PEACE:YX_DIMLayer "J-THIN"));引线图层
(if (not PEACE:YX_Ratio) (setq PEACE:YX_Ratio 100));出图比例
(setq bi (/ PEACE:YX_Ratio 100)
xunh t
bb 3
)
(if (null ptlast)
(setq ptlast '(0.0 0.0))
)
(while (= bb 3)
(setq stylelist '())
(vlax-for style
(vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object)))
(setq stylelist(cons (vla-get-name style) stylelist))
)
(setq stylelist (acad_strlsort stylelist))
(setq layerlist '())
(vlax-for layer
(vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq layerlist(cons (vla-get-name layer) layerlist))
)
(setq layerlist (acad_strlsort layerlist))
(if (not PEACE:YX_TextS)(setq PEACE:YX_TextS (nth 0 stylelist)));文字样式
(if (not (setq stylen (vl-position PEACE:YX_TextS stylelist))) (setq stylen 0))
(if (not (setq layern (vl-position PEACE:YX_TextLayer layerlist))) (setq layern 0))
(setq dclname (cond
((setq tempname (vl-filename-mktemp "yx.dcl")
filen (open tempname "w")
)
(foreach stream '("\n" "yx1:dialog {\n"
" label = \"引线标柱\" ;\n"
" :row { :edit_box { key = \"e01\" ; width = 30 ; height = 1.2 ;}}\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" PEACE:YX_Txt)
(action_tile "e02" "(setq PEACE:YX_Txt (get_tile \"e01\"))(SaveSysVar)(done_dialog 1)")
(action_tile "e04" "(setq PEACE:YX_Txt (get_tile \"e01\"))(SaveSysVar)(done_dialog 2)")
(action_tile "e03" "(setq PEACE:YX_Txt (get_tile \"e01\"))(SaveSysVar)(done_dialog 4)")
(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 = \"e10\" ; }\n"
" :edit_box { label = \"箭头长度\" ; key = \"e03\" ; }\n"
" :edit_box { label = \"引线颜色\" ; key = \"e02\" ; }\n"
" :edit_box { label = \"引线图层\" ; key = \"e11\" ; }\n"
" :edit_box { label = \"出图比例\" ; key = \"e12\" ; }\n"
" :popup_list { label = \"样式\" ; key = \"e13\" ; edit_width = 19 ; height = 1.2 ;} \n"
" :edit_box { label = \"正交对齐\" ; key = \"e07\" ; }\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)
)
(mode_tile "e09" 2)
(start_list "e13")
(mapcar 'add_list stylelist)
(end_list)
(set_tile "e00" (rtos PEACE:YX_TextH 2 2))
(set_tile "e01" (rtos PEACE:YX_TextColor 2 0))
(set_tile "e02" (rtos PEACE:YX_DIMColor 2 0))
(set_tile "e03" (rtos PEACE:YX_DIML 2 2))
(set_tile "e04" (rtos PEACE:YX_TextD 2 2))
(set_tile "e08" (rtos PEACE:YX_TextW2H 2 2))
(set_tile "e10" PEACE:YX_TextLayer)
(set_tile "e11" PEACE:YX_DIMLayer)
(set_tile "e12" (rtos PEACE:YX_Ratio 2 0)
(set_tile "e13" (rtos stylen 2 0)))
(if (= (getvar "ORTHOMODE") 0)
(set_tile "e07" "关 F8切换")
(set_tile "e07" "开 F8切换")
)
;(action_tile "e01" "(if (/= (setq c (acad_colordlg PEACE:YX_TextColor)) nil) (set_tile \"e01\" (itoa c)))")
;(action_tile "e02" "(if (/=(setq c (acad_colordlg PEACE:YX_DIMColor)) nil) (set_tile \"e02\" (itoa c) ))")
(action_tile "e05" "(GETDATA)(SaveSysVar)(done_dialog 3)")
(action_tile "e13" "(setq stylen $value)(setq PEACE:YX_TextS (nth (atoi stylen) stylelist))")
(action_tile "e09" "(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))(set_tile \"e10\" \"J-TEXT\")(set_tile \"e11\" \"J-THIN\")(set_tile \"e12\" \"100\")")
(action_tile "e06" "(done_dialog 3)")
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
)
)
)
(if (= bb 1)
(progn
(setq pt0 (getpoint "\n>>> 指定引线起始位置:"))
(princ (strcat "\n>>> 指定引线基线位置:"))
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 62 PEACE:YX_DIMColor)(cons 8 PEACE:YX_DIMLayer) '(100 . "AcDbPolyline") (cons 90 4) (cons 10 pt0) '(40 . 0.0) (cons 41 (* 0.3 bi PEACE:YX_DIML)) (cons 10 pt0) (cons 10 pt0) (cons 10 pt0))
)
(setq ent1 (entget (setq name1 (entlast))))
(entmake (list '(0 . "TEXT") (cons 62 PEACE:YX_TextColor)(cons 8 PEACE:YX_TextLayer)(cons 7 PEACE:YX_TextS) (cons 1 PEACE:YX_Txt) (cons 10 pt0) (cons 40 (* bi PEACE:YX_TextH))(cons 41 PEACE:YX_TextW2H))
)
(setq ent2 (entget (setq name2 (entlast)))
w (caadr (textbox ent2))
)
(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
)
)
((= code 5) ; 鼠标移动
(if (= (getvar "ORTHOMODE") 1)
(progn
(setq x0 (car ptlast)
y0 (cadr ptlast)
x1 (car data)
y1 (cadr data)
)
(if (< (abs (- x0 x1)) (* 1.5 bi PEACE:YX_TextH))
(setq pt (list x0 y1))
(if (< (abs (- y0 y1)) (* 2 bi PEACE:YX_TextH))
(setq pt (list x1 y0))
(setq pt data)
)
)
)
(setq pt data)
)
(entmod (reent ent1 (list nil (polar pt0 (angle pt0 pt) (* bi PEACE:YX_DIML)) pt (polar pt (if (>
(car pt)
(car pt0)
)
0
pi
) w
)
)
)
)
(entmod (subst
(cons 10 (list (- (car pt) (if (> (car pt) (car pt0))
0
w
)
) (+ (cadr pt) (* bi PEACE:YX_TextD))
)
)
(assoc 10 ent2)
ent2
)
)
(redraw)
)
((or
(= code 11)
(= code 25)
) ; 鼠标右击
(entdel name1)
(entdel name2)
(setq xunh nil)
(redraw)
)
(t
)
)
xunh
)
)
)
)
(command ".UNDO" "E")
(setq *error* $orr)
(princ)
)
(princ "ok")
页:
[1]