设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 那位大神帮看下是什么问题加载不了？？(词库插入）
返回列表 发新帖
查看: 1453|回复: 3

[提问] 那位大神帮看下是什么问题加载不了？？(词库插入）

[复制链接]
正在重生成模型
发表于 2016-3-3 10:50:12 | 显示全部楼层 |阅读模式
本帖最后由 正在重生成模型 于 2016-3-3 10:53 编辑
  2. ;        =============================
  3. ;        |     词库插入t5                 |
  4. ;        |                                |
  5. ;        =============================
  6. ;第一次运行请根据自己需要修改以下内容：
  7. (setq ckml "C:/Users/Administrator/Desktop/" ) ;引号内为词库目录 注意路径为反斜杠“/”
  8. (setq texth 80) ;300为文字高度
  9. ;(setq textst "黑体") ;字体
  10. ;(setq textlay "PP文本") ;WIRE-照明 为文字图层
  11. ;(setq textwh 0.7);0.7为文字宽高比
  12. (setq textsty "0");默认插入文字类型 0为单行文字 1为多行文字


  15. ;以下不用修改

  17. (defun c:t5 ()
  18. (setq suoyin "0")
  19. (setq suoyin2 "0")
  20. (setvar "cmdecho" 0)

  22. (defun xsckdhk( );显示词库对话框
  23.        ;(setq tzbl (getvar "HPSCALE" ));天正比例
  24.        (setq en nill)
  25.        (setq mulu (list "" ))
  26.        (setq mulu (vl-directory-files ckml "*.txt" ))
  27.        (setq ml mulu)
  28.        (setq mulu (list mulu))
  29.        (setq fname (vl-filename-mktemp nil nil ".dcl" ))
  30.        (setq filen (open fname "w" ))
  31.        (foreach x '(
  32.                      "  dcl_settinsx : default_dcl_settings { audit_level = 3; }"
  33.                     " ck:dialog {"
  34.     "label = "词库管理";"
  35.     ":row {"
  36.         ":column {"
  37.             ":list_box {"
  38.                 "fixed_width = true;"
  39.                 "width = 30;"
  40.                 "label = "词组目录:";"
  41.                 "key = "2";"
  42.                 "}"
  43.             "}"
  44.         ":column {"
  45.             ":list_box {"
  46.                 "fixed_width = true;"
  47.                 "width = 60;"
  48.                 "label = "词组内容:";"
  49.                 "key = "1";"
  50.                 "height = 25;"
  51.                 "}"
  52.             "}"
  53.         "}"
  54.     ":boxed_radio_column { "
  55.         "label = "编辑词库";"
  56.         ":row {"
  57.             ":edit_box {"
  58.                 "allow_accept = true;"
  59.                 "height = 1;"
  60.                 "width = 45;"
  61.                 "key = "bjk";"
  62.                 "}"
  63.             "}"
  64.         ":row { "
  65.             "children_fixed_width = true;"
  66.             ":button {"
  67.                 "fixed_width = true;"
  68.                 "width = 28;"
  69.                 "label = "拾取到词库";"
  70.                 "key = "sq";"
  71.                 "}"
  72.             ":button {"
  73.                 "fixed_width = true;"
  74.                 "width = 28;"
  75.                 "label = "添加到词库";"
  76.                 "key = "tj";"
  77.                 "}"
  78.             ":button {"
  79.                 "fixed_width = true;"
  80.                 "width = 28;"
  81.                 "label = "打开文件";"
  82.                 "key = "op";"
  83.                 "}"
  84.             "}"
  85.         "}"
  86.     ":row {"
  87.         ":boxed_radio_row {"
  88.             "children_fixed_width = true;"
  89.             "label = "文字操作";"
  90.             ":column {"
  91.                 ":button {"
  92.                     "fixed_width = true;"
  93.                     "width = 28;"
  94.                     "label = "标注替换";"
  95.                     "key = "bz";"
  96.                     "}"
  97.                 ":button {"
  98.                     "fixed_width = true;"
  99.                     "width = 28;"
  100.                     "label = "文字替换";"
  101.                     "key = "gz";"
  102.                     "}"
  103.                 "}"
  104.             ":column {"
  105.                 ":button {"
  106.                     "fixed_width = true;"
  107.                     "width = 28;"
  108.                     "label = "文字前后缀";"
  109.                     "key = "qz";"
  110.                     "}"
  111.                 ":button { "
  112.                     "fixed_width = true;"
  113.                     "width = 28;"
  114.                     "label = "引线文字";"
  115.                     "key = "yx";"
  116.                     "}"
  117.                 "}"
  118.             "}"
  119.         ":boxed_radio_column {"
  120.             "label = "选择字高";"
  121.             ":row {"
  122.                 ":edit_box {"
  123.                     "}"
  124.                 ":popup_list {"
  125.                     "list = "/n/n10/n20/n30/n40/n50/n60/n70/n80/n90/n100";"
  126.                     "fixed_height = true;"
  127.                     "height = 3;"
  128.                     "fixed_width = true;"
  129.                     "width = 12;"
  130.                     "}"
  131.                 ":spacer {"
  132.                     "}"
  133.                 "}"
  134.             ":button {"
  135.                 "fixed_width = true;"
  136.                 "width = 24;"
  137.                 "label = "插入文字";"
  138.                 "key = "cr";"
  139.                 "}"
  140.             "}"
  141.         "}"
  142.     "cancel_button ;"
  143.     "}"
  144.               );end ;endlist
  145.               (princ x filen)
  146.               (write-line "" filen)
  147.        );end foreach
  148.        (close filen)
  149.        (setq filen (open fname "r" ))
  150.        (setq dclid (load_dialog fname))
  151.        (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" ))))
  152.        (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)

  154.          (start_list "1" )
  155.          (if (= lst nil);第一次读取 第一个txt文件内容
  156.                      (progn
  157.                      (setq text_2 (nth 0 ml))
  158.                      (setq file (open (strcat ckml text_2) "r" ))
  159.                      (setq txt_t (read-line file) lst (list "" ))
  160.                      (while (/= txt_t nil)
  161.                             (setq lst (append lst (list txt_t)))
  162.                             (setq txt_t (read-line file))
  163.                      );end while
  164.                      (close file)
  165.                      (setq lsti lst)
  166.                      (setq lst (list (cdr lst)))
  167.          ));end if
  168.        (mapcar 'add_list (car lst))
  169.        (end_list)
  170.       (load_text suoyin 1)
  171.        (start_list "2" )
  172.        (mapcar 'add_list (car mulu))
  173.        (end_list)
  174.       (set_tile "3" textsty)
  175.       (if bjk-txt
  176.         (set_tile "bjk" bjk-txt)
  177.        )
  178.        (action_tile "1" "(new_text $value $reason)" )
  179.        (action_tile "2" "(load_text $value $reason)  (setq suoyin2 (itoa 0))")
  180.        (action_tile "3" "(setq textsty $value)")
  181.        (action_tile "4" "(setq textsty $value)") ;;;引线文字
  182.        (action_tile "5" "(setq textsty $value)") ;;;插入文字
  183.        (action_tile "6" "(setq textsty $value)") ;;;前后缀
  184.        (action_tile "7" "(setq textsty $value)") ;;;标注替换
  185.   
  186.       (action_tile "sq" "(done_dialog 1)")
  187.       (action_tile "op" "(done_dialog 2)")
  188.       (action_tile "gz" "(done_dialog 3)")
  189.       (action_tile "yx" "(done_dialog 4)");;;;引线文字
  190.       (action_tile "cr" "(done_dialog 5)");;;插入文字
  191.       (action_tile "qz" "(done_dialog 6)");;;前后缀
  192.       (action_tile "bz" "(done_dialog 7)");;;标注替换


  195.       (action_tile "bjk" "(setq bjk-txt $value)")
  196.       (action_tile "tj" "(tjwz)")
  197.        (set_tile "2" suoyin);获取焦点
  198.        (set_tile "1" suoyin2)
  199.        (action_tile "cancel" "(done_dialog 0)" )
  200.       (setq re (start_dialog))
  201.        (cond
  202.         ((= re 1) (shiqu))
  203.         ((= re 2) (dkwj))
  204.         ((= re 3) (gtzwz))
  205.         ((= re 4) (yxwz));;;引线文字
  206.         ((= re 5) (crwz));;;引线文字
  207.         ((= re 6) (qzwz));;;前后缀
  208.         ((= re 7) (qhbz));;;标注替换


  211.        )
  212.        (start_dialog)
  213.        (unload_dialog dclid)
  214.        (close filen)
  215.        (vl-file-delete fname)

  217.        (if (/= en nill) ;动态文字
  218.           (progn
  219.           (princ "\n点取位置或[转90度(A)/右键退出]")
  220.           (setq boolean t)
  221.           (setq text-jiaodu 0)
  222.           (while boolean
  223.            (setq motion (grread T 8));grread 函数返回一个表，其中第一个元素说明输入类型的代码，第二个元素既可能是整数，又可能是点
  224.            (setq code (car motion)) ;grread表第一个元素输入类型的代码
  225.            (setq pt2 (cadr motion)) ;grread表第二个元素 拖动模式坐标
  226.            (cond
  227.             ((= code 5)   ;鼠标拖动模式
  228.              (entmod (setq endate (subst (cons 10 pt2) (assoc 10 endate) endate)));动态改文字坐标
  229.             )
  230.             ((= code 3)   ;鼠标左鍵按下
  231.             (setq boolean nil)
  232.             )
  233.             ((= code 11)
  234.              (setq boolean nil)
  235.              (entdel en)
  236.             )
  237.             ((= code 25)
  238.              (setq boolean nil)
  239.              (entdel en)
  240.             )
  241.             ((equal motion '(2 32))
  242.              (setq boolean nil)
  243.             )
  244.             ((equal motion '(2 13))
  245.              (setq boolean nil)
  246.             )
  247.             ((equal motion '(2 27))
  248.              (setq boolean nil)
  249.              (entdel en)
  250.             )
  251.             ((equal motion '(2 65))
  252.              (setq text-jiaodu (+ text-jiaodu (/ pi 2)))
  253.              (entmod (setq endate (subst (cons 50 text-jiaodu) (assoc 50 endate) endate)));动态改文字角度
  254.             )
  255.             ((equal motion '(2 97))
  256.              (setq text-jiaodu (+ text-jiaodu (/ pi 2)))
  257.              (entmod (setq endate (subst (cons 50 text-jiaodu) (assoc 50 endate) endate)));动态改文字角度
  258.             )
  259.            )
  260.           );end while
  261.       ));end if
  262. (princ)
  263. ) ;end xsckdhk

  265. (defun load_text (value reason);子函数 提取txt内容
  266.        (if (= reason 1)
  267.               (progn
  268.                      (setq suoyin value)
  269.                      (setq text_2 (nth (atoi value) ml))
  270.                      (setq file (open (strcat ckml text_2) "r" ))
  271.                      (setq txt_t (read-line file) lst (list "" ))
  272.                      (while (/= txt_t nil)
  273.                             (setq lst (append lst (list txt_t)))
  274.                             (setq txt_t (read-line file))
  275.                      );end while
  276.                      (close file)
  277.                      (setq lsti lst)
  278.                      (setq lst (list (cdr lst)))
  279.        ));end if
  280.        (start_list "1" )
  281.        (mapcar 'add_list (car lst))
  282.        (end_list)
  283.       (setq wjm (nth (atoi value) ml))
  284.        (setq filename (strcat ckml wjm))
  285. );end load_text

  287. (defun new_text (value reason / ttlen twid)
  288.        (setq text (nth (1+ (atoi value)) lsti))
  289.        (if (= reason 4)
  290.               (progn
  291.                      (done_dialog 0);关闭对话框
  292.                      (setq pt (cadr (grread 1)));取得光标坐标
  293.                      (if pt
  294.       (if (= textsty "0")
  295.                             (progn
  296.                                    (entmake (list
  297.                                                  '(0 . "TEXT" );单行文字
  298.                                                       (cons 1 text)
  299.                                                       (cons 7 textst)
  300.                                                       (cons 8 textlay)
  301.                                                                  (cons 10 pt)
  302.                                                       ;(cons 40 (/ (* tzbl texth) 100))
  303.                                                (cons 40 texth)   
  304.                                                       (cons 41 textwh)                                                   
  305.                                                   );end list
  306.                                      );end entmake
  307.                                       (setq en (entlast))
  308.                                       (setq endate (entget (entlast)))
  309.                         )
  310.                             (progn
  311.             (setq ttlen (strlen text))   ;取得文本长度
  312.                                    (setq twid (* (* (* texth 0.7) ttlen) (/ tzbl 100)))  ;计算文本宽度
  313.                                    (entmake (list
  314.                                                  '(0 . "MTEXT" );多行文字
  315.                                                       (cons 100 "AcDbEntity")  
  316.                                                       (cons 100 "AcDbMText")  
  317.                                                       (cons 1 text)
  318.                                                       (cons 7 textst)
  319.                                                       (cons 8 textlay)
  320.                                                                  (cons 10 pt)
  321.                                                       ;(cons 40 (/ (* tzbl texth) 100))
  322.                                                (cons 40 texth)
  323.                                                       (cons 41 twid)                                                
  324.                                                   );end list
  325.                                      );end entmake
  326.                                       (setq en (entlast))
  327.                                       (setq endate (entget (entlast)))
  328.                             )
  329.                        )                        
  330.                      );end if
  331.               );end progn
  332.        );end if
  333.       (if (= reason 1)
  334.           (setq suoyin2 value)
  335.       )
  336. );end new_text

  338. ;拾取文字
  339. (defun shiqu (/ ent1)
  340.   (if (setq ent1 (entsel ))
  341.    (progn
  342.       (setq bjk-txt (cdr (assoc 1 (entget (car ent1)))));文字内容
  343.      (xsckdhk)
  344.   ))
  345. );end shiqu

  347. ;打开文件
  348. (defun dkwj()
  349.    (startapp "notepad" filename)
  350. )

  352. ;改图中文字
  353. (defun gtzwz (/ sel i ent ob)
  354.   (if (setq sel (ssget '((0 . "TEXT,MTEXT"))))
  355.   (progn
  356.   (setq i 0)
  357.   (repeat (sslength sel)
  358.     (setq ent (ssname sel i))
  359.     (setq ob (vlax-ename->vla-object ent)) ;转换
  360.     (vlax-put-property ob 'TextString text) ;改变text特性
  361.     (setq i (1+ i))
  362.   )
  363.   ))
  364. (princ)
  365. )

  367. ;;;;引线文字  50%
  368. (defun yxwz ()


  371. (setq chksty(tblsearch "style" "黑体"))   ;检测字体是否存在
  372. (if (null chksty)  ;如果不存在，则新建字体
  373. (command "_style" "黑体" "SIMHEI.TTF" "0" "1" "0" "N" "N")
  374. )
  375. (setq chklay(tblsearch "layer" "PP文本"))  ;检测图层是否存在
  376. (if (null chklay)  ;如果不存在，则新建图层
  377. (command "_layer" "M" "PP文本" "C" "75" "" "lweight" "0.18" "" )
  378. )
  379. (setvar "clayer" "PP文本")  ;预设目前作图层
  380. (setvar "textstyle" "黑体")  ;预设目前字体


  383. ;(command "style" "黑体" "SIMHEI.TTF" "0" "1" "0" "N" "N")
  384. ;(command "dimtxt"   "2.5"   "dimasz"   "2"      "dimexe"
  385. ;(command "dimtxt"   ""   "dimasz"   "2"      "dimexe"
  386.    ;  ".5"        "dimexo"   "0.5"      "dimgap"   "0.5"
  387.    ;  "dimtoh"   "off"   "dimtih"   "OFF"      "blipmode"
  388.    ;  "0"        "DIMDLI"   "5"      "DIMATFIT" "3"
  389.    ;  "DIMTAD"   "0"   "DIMDEC"   "2"         "DIMTXSTY"
  390.     ; "txt"   "DIMCLRT"   "4"      "DIMJUST"  "0"
  391.     ; "DIMDSEP"  "."   "DIMTOFL"  "0" "dimtmove" "0"
  392.      ;"dimcen" "0" "dimclrd" "6" "dimclre" "4"
  393.    ; )

  395. ;(command"style""""txt""""""""""")



  399. (command  "leader" pause pause "" text ""  )


  402. (princ)
  403. )
  404. ;;;插入文字ok
  405. (defun crwz ()
  406. ;(COMMAND "_MTEXT" PAUSE PAUSE text "");;多行文本
  407. (COMMAND "_TEXT" PAUSE TEXTH  ""  TEXT );;单行文本
  408. (princ)
  409. )


  412. ;标注替换
  413. (defun qhbz ()

  415. (SSGET)
  416. (COMMAND "DIM" "N"  text "P" "" "EXIT" )
  417. (princ)
  418. )


  421. (defun qzwz()
  422.      (setvar "cmdecho" 0) ;指令执行过程不响应
  423.      (PRINC "\n LISAN工具箱---文本加前后缀功能")(PRINC)
  424. (setq qh (getint "\n1--加前缀,2--加后缀,<2>"))


  427. (if (= qh nil)(setq qh 2))
  428. (princ "\nselect object:")
  429. (while (setq s (ssget":s"))
  430. (setq str text)
  431. (setq n (sslength s))
  432. (setq k 0 )
  433. (while (< k n)
  434.       (setq name (ssname s k))
  435.       (setq a (entget name))
  436.       (setq t1 (assoc '0 a))
  437.       (setq t1 (cdr t1))
  438.       (if (or (= t1 "TEXT")(= t1 "MTEXT")) (PROGN
  439.         (setq h (assoc '1 a))
  440.   (setq hh (cdr h))
  441.         (if (= qh 1)(setq  str1 (strcat str hh)))
  442.   (if (/= qh 1)(setq str1 (strcat hh str)))
  443.   (setq h1 (cons 1 str1))
  444.         ;(if (= str "") (setq h1 h))
  445.         (setq a (subst h1 h a))
  446.         (entmod a)
  447.         ))
  448.       (setq k (+ k 1))
  449. ) )
  450.      (PRINC))





  456. ;添加文字到词库
  457. (defun tjwz(/ file)
  458.   (if (/= bjk-txt "")
  459.    (progn
  460.    (setq file (open filename "a"))
  461.    (write-line bjk-txt file)
  462.    (close file)
  463.    (load_text suoyin 1) ;刷新文字内容
  464.   ))
  465. )

  467. (xsckdhk)
  468. (setvar "cmdecho" 1)
  469. (princ)
  470. );end defun
如题；附上代码
         文字字高也使用不了

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复

使用道具 举报

kozmosovia
发表于 2016-3-3 11:57:25 | 显示全部楼层
粗粗看了一下，DCL的定义还有很多问题，好好看看帮助文档把DCL文件写对了再用程序生成DCL。
DCL SETTINGS定义错误
字高的EDITBOX连KEY都没有怎么操作？
SPACER是内定控件，不需要前面加：
。。。
回复 支持 反对

使用道具 举报

USER2128
发表于 2016-3-3 15:11:49 | 显示全部楼层
如果搞成了，不惜为一个好工具！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-19 13:43 , Processed in 0.212763 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表