那位大神帮看下是什么问题加载不了？？(词库插入）
本帖最后由 正在重生成模型 于 2016-3-3 10:53 编辑; =============================
; | 词库插入t5 |
; | |
; =============================
;第一次运行请根据自己需要修改以下内容：
(setq ckml "C:/Users/Administrator/Desktop/" ) ;引号内为词库目录 注意路径为反斜杠“/”
(setq texth 80) ;300为文字高度
;(setq textst "黑体") ;字体
;(setq textlay "PP文本") ;WIRE-照明 为文字图层
;(setq textwh 0.7);0.7为文字宽高比
(setq textsty "0");默认插入文字类型 0为单行文字 1为多行文字
;以下不用修改
(defun c:t5 ()
(setq suoyin "0")
(setq suoyin2 "0")
(setvar "cmdecho" 0)
(defun xsckdhk( );显示词库对话框
;(setq tzbl (getvar "HPSCALE" ));天正比例
(setq en nill)
(setq mulu (list "" ))
(setq mulu (vl-directory-files ckml "*.txt" ))
(setq ml mulu)
(setq mulu (list mulu))
(setq fname (vl-filename-mktemp nil nil ".dcl" ))
(setq filen (open fname "w" ))
(foreach x '(
"dcl_settinsx : default_dcl_settings { audit_level = 3; }"
" ck:dialog {"
"label = \"词库管理\";"
":row {"
":column {"
":list_box {"
"fixed_width = true;"
"width = 30;"
"label = \"词组目录:\";"
"key = \"2\";"
"}"
"}"
":column {"
":list_box {"
"fixed_width = true;"
"width = 60;"
"label = \"词组内容:\";"
"key = \"1\";"
"height = 25;"
"}"
"}"
"}"
":boxed_radio_column { "
"label = \"编辑词库\";"
":row {"
":edit_box {"
"allow_accept = true;"
"height = 1;"
"width = 45;"
"key = \"bjk\";"
"}"
"}"
":row { "
"children_fixed_width = true;"
":button {"
"fixed_width = true;"
"width = 28;"
"label = \"拾取到词库\";"
"key = \"sq\";"
"}"
":button {"
"fixed_width = true;"
"width = 28;"
"label = \"添加到词库\";"
"key = \"tj\";"
"}"
":button {"
"fixed_width = true;"
"width = 28;"
"label = \"打开文件\";"
"key = \"op\";"
"}"
"}"
"}"
":row {"
":boxed_radio_row {"
"children_fixed_width = true;"
"label = \"文字操作\";"
":column {"
":button {"
"fixed_width = true;"
"width = 28;"
"label = \"标注替换\";"
"key = \"bz\";"
"}"
":button {"
"fixed_width = true;"
"width = 28;"
"label = \"文字替换\";"
"key = \"gz\";"
"}"
"}"
":column {"
":button {"
"fixed_width = true;"
"width = 28;"
"label = \"文字前后缀\";"
"key = \"qz\";"
"}"
":button { "
"fixed_width = true;"
"width = 28;"
"label = \"引线文字\";"
"key = \"yx\";"
"}"
"}"
"}"
":boxed_radio_column {"
"label = \"选择字高\";"
":row {"
":edit_box {"
"}"
":popup_list {"
"list = \"/n/n10/n20/n30/n40/n50/n60/n70/n80/n90/n100\";"
"fixed_height = true;"
"height = 3;"
"fixed_width = true;"
"width = 12;"
"}"
":spacer {"
"}"
"}"
":button {"
"fixed_width = true;"
"width = 24;"
"label = \"插入文字\";"
"key = \"cr\";"
"}"
"}"
"}"
"cancel_button ;"
"}"
);end ;endlist
(princ x filen)
(write-line "" filen)
);end foreach
(close filen)
(setq filen (open fname "r" ))
(setq dclid (load_dialog fname))
(while (or (eq (substr (setq lin (vl-string-right-trim "\" filen)" (vl-string-left-trim "(write-line \"" (read-line filen)))) 1 2) "//" ) (eq (substr lin 1 (vl-string-search " " lin)) "" ) (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog" ))))
(new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
(start_list "1" )
(if (= lst nil);第一次读取 第一个txt文件内容
(progn
(setq text_2 (nth 0 ml))
(setq file (open (strcat ckml text_2) "r" ))
(setq txt_t (read-line file) lst (list "" ))
(while (/= txt_t nil)
(setq lst (append lst (list txt_t)))
(setq txt_t (read-line file))
);end while
(close file)
(setq lsti lst)
(setq lst (list (cdr lst)))
));end if
(mapcar 'add_list (car lst))
(end_list)
(load_text suoyin 1)
(start_list "2" )
(mapcar 'add_list (car mulu))
(end_list)
(set_tile "3" textsty)
(if bjk-txt
(set_tile "bjk" bjk-txt)
)
(action_tile "1" "(new_text $value $reason)" )
(action_tile "2" "(load_text $value $reason)(setq suoyin2 (itoa 0))")
(action_tile "3" "(setq textsty $value)")
(action_tile "4" "(setq textsty $value)") ;;;引线文字
(action_tile "5" "(setq textsty $value)") ;;;插入文字
(action_tile "6" "(setq textsty $value)") ;;;前后缀
(action_tile "7" "(setq textsty $value)") ;;;标注替换
(action_tile "sq" "(done_dialog 1)")
(action_tile "op" "(done_dialog 2)")
(action_tile "gz" "(done_dialog 3)")
(action_tile "yx" "(done_dialog 4)");;;;引线文字
(action_tile "cr" "(done_dialog 5)");;;插入文字
(action_tile "qz" "(done_dialog 6)");;;前后缀
(action_tile "bz" "(done_dialog 7)");;;标注替换
(action_tile "bjk" "(setq bjk-txt $value)")
(action_tile "tj" "(tjwz)")
(set_tile "2" suoyin);获取焦点
(set_tile "1" suoyin2)
(action_tile "cancel" "(done_dialog 0)" )
(setq re (start_dialog))
(cond
((= re 1) (shiqu))
((= re 2) (dkwj))
((= re 3) (gtzwz))
((= re 4) (yxwz));;;引线文字
((= re 5) (crwz));;;引线文字
((= re 6) (qzwz));;;前后缀
((= re 7) (qhbz));;;标注替换
)
(start_dialog)
(unload_dialog dclid)
(close filen)
(vl-file-delete fname)
(if (/= en nill) ;动态文字
(progn
(princ "\n点取位置或[转90度(A)/右键退出]")
(setq boolean t)
(setq text-jiaodu 0)
(while boolean
(setq motion (grread T 8));grread 函数返回一个表，其中第一个元素说明输入类型的代码，第二个元素既可能是整数，又可能是点
(setq code (car motion)) ;grread表第一个元素输入类型的代码
(setq pt2 (cadr motion)) ;grread表第二个元素 拖动模式坐标
(cond
((= code 5) ;鼠标拖动模式
(entmod (setq endate (subst (cons 10 pt2) (assoc 10 endate) endate)));动态改文字坐标
)
((= code 3) ;鼠标左鍵按下
(setq boolean nil)
)
((= code 11)
(setq boolean nil)
(entdel en)
)
((= code 25)
(setq boolean nil)
(entdel en)
)
((equal motion '(2 32))
(setq boolean nil)
)
((equal motion '(2 13))
(setq boolean nil)
)
((equal motion '(2 27))
(setq boolean nil)
(entdel en)
)
((equal motion '(2 65))
(setq text-jiaodu (+ text-jiaodu (/ pi 2)))
(entmod (setq endate (subst (cons 50 text-jiaodu) (assoc 50 endate) endate)));动态改文字角度
)
((equal motion '(2 97))
(setq text-jiaodu (+ text-jiaodu (/ pi 2)))
(entmod (setq endate (subst (cons 50 text-jiaodu) (assoc 50 endate) endate)));动态改文字角度
)
)
);end while
));end if
(princ)
) ;end xsckdhk
(defun load_text (value reason);子函数 提取txt内容
(if (= reason 1)
(progn
(setq suoyin value)
(setq text_2 (nth (atoi value) ml))
(setq file (open (strcat ckml text_2) "r" ))
(setq txt_t (read-line file) lst (list "" ))
(while (/= txt_t nil)
(setq lst (append lst (list txt_t)))
(setq txt_t (read-line file))
);end while
(close file)
(setq lsti lst)
(setq lst (list (cdr lst)))
));end if
(start_list "1" )
(mapcar 'add_list (car lst))
(end_list)
(setq wjm (nth (atoi value) ml))
(setq filename (strcat ckml wjm))
);end load_text
(defun new_text (value reason / ttlen twid)
(setq text (nth (1+ (atoi value)) lsti))
(if (= reason 4)
(progn
(done_dialog 0);关闭对话框
(setq pt (cadr (grread 1)));取得光标坐标
(if pt
(if (= textsty "0")
(progn
(entmake (list
'(0 . "TEXT" );单行文字
(cons 1 text)
(cons 7 textst)
(cons 8 textlay)
(cons 10 pt)
;(cons 40 (/ (* tzbl texth) 100))
(cons 40 texth)
(cons 41 textwh)
);end list
);end entmake
(setq en (entlast))
(setq endate (entget (entlast)))
)
(progn
(setq ttlen (strlen text)) ;取得文本长度
(setq twid (* (* (* texth 0.7) ttlen) (/ tzbl 100)));计算文本宽度
(entmake (list
'(0 . "MTEXT" );多行文字
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 1 text)
(cons 7 textst)
(cons 8 textlay)
(cons 10 pt)
;(cons 40 (/ (* tzbl texth) 100))
(cons 40 texth)
(cons 41 twid)
);end list
);end entmake
(setq en (entlast))
(setq endate (entget (entlast)))
)
)
);end if
);end progn
);end if
(if (= reason 1)
(setq suoyin2 value)
)
);end new_text
;拾取文字
(defun shiqu (/ ent1)
(if (setq ent1 (entsel ))
(progn
(setq bjk-txt (cdr (assoc 1 (entget (car ent1)))));文字内容
(xsckdhk)
))
);end shiqu
;打开文件
(defun dkwj()
(startapp "notepad" filename)
)
;改图中文字
(defun gtzwz (/ sel i ent ob)
(if (setq sel (ssget '((0 . "TEXT,MTEXT"))))
(progn
(setq i 0)
(repeat (sslength sel)
(setq ent (ssname sel i))
(setq ob (vlax-ename->vla-object ent)) ;转换
(vlax-put-property ob 'TextString text) ;改变text特性
(setq i (1+ i))
)
))
(princ)
)
;;;;引线文字50%
(defun yxwz ()
(setq chksty(tblsearch "style" "黑体")) ;检测字体是否存在
(if (null chksty);如果不存在，则新建字体
(command "_style" "黑体" "SIMHEI.TTF" "0" "1" "0" "N" "N")
)
(setq chklay(tblsearch "layer" "PP文本"));检测图层是否存在
(if (null chklay);如果不存在，则新建图层
(command "_layer" "M" "PP文本" "C" "75" "" "lweight" "0.18" "" )
)
(setvar "clayer" "PP文本");预设目前作图层
(setvar "textstyle" "黑体");预设目前字体
;(command "style" "黑体" "SIMHEI.TTF" "0" "1" "0" "N" "N")
;(command "dimtxt" "2.5" "dimasz" "2" "dimexe"
;(command "dimtxt" "" "dimasz" "2" "dimexe"
;".5" "dimexo" "0.5" "dimgap" "0.5"
;"dimtoh" "off" "dimtih" "OFF" "blipmode"
;"0" "DIMDLI" "5" "DIMATFIT" "3"
;"DIMTAD" "0" "DIMDEC" "2" "DIMTXSTY"
; "txt" "DIMCLRT" "4" "DIMJUST""0"
; "DIMDSEP""." "DIMTOFL""0" "dimtmove" "0"
;"dimcen" "0" "dimclrd" "6" "dimclre" "4"
; )
;(command"style""""txt""""""""""")
(command"leader" pause pause "" text "")
(princ)
)
;;;插入文字ok
(defun crwz ()
;(COMMAND "_MTEXT" PAUSE PAUSE text "");;多行文本
(COMMAND "_TEXT" PAUSE TEXTH""TEXT );;单行文本
(princ)
)
;标注替换
(defun qhbz ()
(SSGET)
(COMMAND "DIM" "N"text "P" "" "EXIT" )
(princ)
)
(defun qzwz()
(setvar "cmdecho" 0) ;指令执行过程不响应
(PRINC "\n LISAN工具箱---文本加前后缀功能")(PRINC)
(setq qh (getint "\n1--加前缀,2--加后缀,<2>"))
(if (= qh nil)(setq qh 2))
(princ "\nselect object:")
(while (setq s (ssget":s"))
(setq str text)
(setq n (sslength s))
(setq k 0 )
(while (< k n)
(setq name (ssname s k))
(setq a (entget name))
(setq t1 (assoc '0 a))
(setq t1 (cdr t1))
(if (or (= t1 "TEXT")(= t1 "MTEXT")) (PROGN
(setq h (assoc '1 a))
(setq hh (cdr h))
(if (= qh 1)(setqstr1 (strcat str hh)))
(if (/= qh 1)(setq str1 (strcat hh str)))
(setq h1 (cons 1 str1))
;(if (= str "") (setq h1 h))
(setq a (subst h1 h a))
(entmod a)
))
(setq k (+ k 1))
) )
(PRINC))
;添加文字到词库
(defun tjwz(/ file)
(if (/= bjk-txt "")
(progn
(setq file (open filename "a"))
(write-line bjk-txt file)
(close file)
(load_text suoyin 1) ;刷新文字内容
))
)
(xsckdhk)
(setvar "cmdecho" 1)
(princ)
);end defun如题；附上代码
文字字高也使用不了 粗粗看了一下，DCL的定义还有很多问题，好好看看帮助文档把DCL文件写对了再用程序生成DCL。
DCL SETTINGS定义错误
字高的EDITBOX连KEY都没有怎么操作？
SPACER是内定控件，不需要前面加：
。。。 如果搞成了，不惜为一个好工具！ 不要沉
页:
[1]