明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 35682|回复: 92

[【风之影】] [源码]智能技术要求库

    [复制链接]
发表于 2012-2-21 22:35:34 | 显示全部楼层 |阅读模式
本帖最后由 cabinsummer 于 2016-12-24 15:06 编辑

本程序是十几年前开发的。这几天匆匆整理了一下,优化了一下代码,将原来500多行的程序精简到200多行,但总觉得没有达到乔布斯那样的理念。现在有了一些新思路,但群友们强烈要求,所以先把这个版本公布出来,以后进一步优化后再另立新帖。

程序效果:


程序命令:TCF
将对话框文件存成tcf.dcl
再建立一个tcf.ini文本文件放技术要求库,这个务必要有,否则将出错。
采集入库目前只能选择单行文本
这几个文件都要在搜索路径中

  1. teclib :dialog
  2. {
  3.   label="技术要求";
  4.   :boxed_row
  5.   {
  6.     label="技术要求库";
  7.     :column
  8.     {
  9.       :list_box
  10.       {
  11.         key="itemlist";
  12.         value="0";
  13.         width=43;
  14.         height=10;
  15.         fixed_width=true;
  16.         allow_accept=true;
  17.         value="0";
  18.       }
  19.       :edit_box
  20.       {
  21.         key="item";
  22.         width=24;
  23.         allow_accept=true;
  24.       }
  25.       spacer;
  26.     }
  27.     :column
  28.     {
  29.       fixed_width = true;
  30.       alignment = centered;
  31.       :button
  32.       {
  33.         label="添加";
  34.         key="add";
  35.         fixed_width=true;
  36.       }
  37.       :button
  38.       {
  39.         label="删除";
  40.         key="del";
  41.         fixed_width=true;
  42.       }
  43.       :button
  44.       {
  45.         label="上移";
  46.         key="up";
  47.         fixed_width=true;
  48.       }
  49.       :button
  50.       {
  51.         label="下移";
  52.         key="down";
  53.         fixed_width=true;
  54.       }
  55.       :button
  56.       {
  57.         label="修改";
  58.         key="mdf";
  59.         fixed_width=true;
  60.       }
  61.     }
  62.   }
  63.   :boxed_row
  64.   {
  65.     label="技术要求项";
  66.     :list_box
  67.     {
  68.       key="itemlist0";
  69.       value="0";
  70.       width=43;
  71.       height=10;
  72.       fixed_width=true;
  73.       value="0";
  74.     }
  75.     :column
  76.     {
  77.       fixed_width=true;
  78.       alignment = centered;
  79.       :button
  80.       {
  81.         label="加入";
  82.         key="addlist";
  83.         fixed_width=true;
  84.       }
  85.       :button
  86.       {
  87.         label="去除";
  88.         key="removelist";
  89.         fixed_width=true;
  90.       }
  91.       :button
  92.       {
  93.         label="上移";
  94.         key="up0";
  95.         fixed_width=true;
  96.       }
  97.       :button
  98.       {
  99.         label="下移";
  100.         key="down0";
  101.         fixed_width=true;
  102.       }
  103.     }
  104.   }
  105.   :row
  106.   {
  107.     :button
  108.     {
  109.       label="采集入库";
  110.       key="pick";
  111.       fixed_width=true;
  112.     }
  113.     ok_cancel;
  114.   }
  115. }


  1. (defun delsame (list0) (if list0 (cons (car list0) (delsame (vl-remove (car list0) list0)))))
  2. (defun fwrdlist (list0 n)
  3.   (reverse (cdr (member (nth n list0) (reverse list0))))
  4. )
  5. (defun backlist (list0 n)
  6.   (cdr (member (nth n list0) list0))
  7. )
  8. (defun swapfwrd (list0 n)
  9.   (if (and (>= (1- n) 0) (> (length crtlst) n))
  10.     (setq list0 (append (fwrdlist list0 (1- n)) (list (nth n list0) (nth (1- n) list0)) (backlist list0 n)))
  11.   )
  12.   list0
  13. )
  14. (defun swapback (list0 n)
  15.   (if (and (>= n 0) (> (length crtlst) (1+ n)))
  16.     (setq list0 (append (fwrdlist list0 n) (list (nth (1+ n) list0) (nth n list0)) (backlist list0 (1+ n))))
  17.   )
  18.   list0
  19. )
  20. (defun add_item (list0 n item)
  21.   (if (and (>= n 0) (> (length crtlst) n))
  22.     (append (fwrdlist list0 n) (list item (nth n list0)) (backlist list0 n))
  23.   )
  24. )
  25. (defun del_item (list0 n)
  26.   (if (and (>= n 0) (> (length crtlst) n))
  27.     (append (fwrdlist list0 n) (backlist list0 n))
  28.   )
  29. )
  30. (defun mdfylist (list0 n item)
  31.   (if (and (>= n 0) (> (length crtlst) n))
  32.     (append (fwrdlist list0 n) (list item) (backlist list0 n))
  33.   )
  34. )
  35. (defun readfn (/ fn ftext crtlst)
  36.   (setq fn (open (findfile "tcf.ini") "r"))
  37.   (while (setq ftext (read-line fn)) (setq crtlst (append crtlst (list ftext))))
  38.   (close fn)
  39.   (setq textstr (nth 0 crtlst))
  40.   crtlst
  41. )
  42. (defun writefn (crtlst / fn)
  43.   (setq fn (open (findfile "tcf.ini") "w"))
  44.   (foreach x crtlst (write-line x fn))
  45.   (close fn)
  46. )
  47. (defun updlst (key lst /)
  48.   (start_list key 3)
  49.   (mapcar 'add_list lst)
  50.   (end_list)
  51. )
  52. (defun do_list (key / n)
  53.   (setq n (atoi (get_tile key)))
  54.   (setq textstr (nth n crtlst))
  55.   (cond
  56.     ((= key "itemlist")
  57.       (if (= (length crtlst) (1+ n))(mode_tile "down" 1)(mode_tile "down" 0))
  58.       (if (= n 0)(mode_tile "up" 1)(mode_tile "up" 0))
  59.       (set_tile "item" textstr)
  60.       (mode_tile "item" 2)
  61.     )
  62.     ((= key "itemlist0")
  63.       (if (= (length crtlst0) (1+ n))(mode_tile "down0" 1)(mode_tile "down0" 0))
  64.       (if (= n 0)(mode_tile "up0" 1)(mode_tile "up0" 0))
  65.     )
  66.   )
  67. )
  68. (defun mdfitem (/ n textstr)
  69.   (setq n (atoi (get_tile "itemlist")) textstr (get_tile "item"))
  70.   (setq crtlst (mdfylist crtlst n textstr))
  71.   (writefn crtlst)
  72.   (updlst "itemlist" crtlst)
  73.   (set_tile "itemlist" (itoa n))
  74.   (do_list "itemlist")
  75. )
  76. (defun additem ()
  77.   (setq crtlst (add_item crtlst (atoi (get_tile "itemlist")) (get_tile "item")))
  78.   (writefn crtlst)
  79.   (updlst "itemlist" crtlst)
  80.   (set_tile "itemlist" "0")
  81.   (do_list "itemlist")
  82. )
  83. (defun delitem ()
  84.   (setq crtlst (del_item crtlst (atoi (get_tile "itemlist"))))
  85.   (writefn crtlst)
  86.   (updlst "itemlist" crtlst)
  87.   (set_tile "itemlist" "0")
  88.   (do_list "itemlist")
  89. )
  90. (defun upitem (/ n textstr0 val)
  91.   (if (> (setq n (atoi (get_tile "itemlist"))) 0)
  92.     (progn
  93.       (setq crtlst (swapfwrd crtlst n))
  94.       (writefn crtlst)
  95.       (updlst "itemlist" crtlst)
  96.       (set_tile "itemlist" (itoa (1- n)))
  97.       (do_list "itemlist")
  98.     )
  99.   )
  100. )
  101. (defun downitem (/ n)
  102.   (if (< (setq n (atoi (get_tile "itemlist"))) (1- (length crtlst)))
  103.     (progn
  104.       (setq crtlst (swapback crtlst n))
  105.       (writefn crtlst)
  106.       (updlst "itemlist" crtlst)
  107.       (set_tile "itemlist" (itoa (1+ n)))
  108.       (do_list "itemlist")
  109.     )
  110.   )
  111. )
  112. (defun upitem0 (/ n)
  113.   (if (> (setq n (atoi (get_tile "itemlist0"))) 0)
  114.     (progn
  115.       (setq crtlst0 (swapfwrd crtlst0 n))
  116.       (updlst "itemlist0" crtlst0)
  117.       (set_tile "itemlist0" (itoa (1- n)))
  118.       (do_list "itemlist0")
  119.     )
  120.   )
  121. )
  122. (defun downitem0 (/ n val temp)
  123.   (if (< (setq n (atoi (get_tile "itemlist0"))) (1- (length crtlst0)))
  124.     (progn
  125.       (setq crtlst0 (swapback crtlst0 n))
  126.       (updlst "itemlist0" crtlst0)
  127.       (set_tile "itemlist0" (itoa (1+ n)))
  128.       (do_list "itemlist0")
  129.     )
  130.   )
  131. )
  132. (defun addlist ()
  133.   (setq crtlst0 (delsame (append crtlst0 (list (get_tile "item")))))
  134.   (updlst "itemlist0" crtlst0)
  135.   (set_tile "itemlist0" (itoa (1- (length crtlst0))))
  136.   (mode_tile "removelist" 0)
  137.   (do_list "itemlist0")
  138. )
  139. (defun removelist (/ n)
  140.   (setq n (atoi (get_tile "itemlist0")))
  141.   (setq crtlst0 (del_item crtlst0 n))
  142.   (updlst "itemlist0" crtlst0)
  143.   (set_tile "itemlist0" "0")
  144.   (if (null crtlst0)(mode_tile "removelist" 1))
  145.   (do_list "itemlist0")
  146. )
  147. (defun tolib (/ ss fn n txt)
  148.   (setq ss (ssget '((0 . "text"))) do_what nil)
  149.   (if ss
  150.     (progn
  151.       (setq n 0)
  152.       (repeat (sslength ss)
  153.         (setq crtlst (append crtlst (list (cdr (assoc 1 (entget (ssname ss n)))))) n (1+ n))
  154.       )
  155.       (setq crtlst (delsame crtlst))
  156.       (writefn crtlst)
  157.       (updlst "itemlist" crtlst)
  158.     )
  159.   )
  160.   (setq crtlst0 nil)
  161.   (princ)
  162. )
  163. (defun c:tcf (/ textstr0 scl DLG_ID index result crd crtlst n crtlst0 kd do_what)
  164.   (setvar "cmdecho" 0)
  165.   (command "undo" "be")
  166.   (setq syserr *error* *error* '(nil (princ)))
  167.   (setq scl (getvar "dimscale"))
  168.   (setq crtlst (readfn))
  169.   (if (> (setq DLG_ID (load_dialog (findfile "tcf.dcl"))) 0)
  170.     (while (and (/= result 1) (/= result 0))
  171.       (if (= do_what 3)
  172.         (tolib)
  173.       )
  174.       (if (new_dialog "teclib" DLG_ID)
  175.         (progn
  176.           (updlst "itemlist" crtlst)
  177.           (set_tile "itemlist" "0")
  178.           (set_tile "item" textstr)
  179.           (mode_tile "item" 2)
  180.           (mode_tile "up" 1)
  181.           (mode_tile "up0" 1)
  182.           (mode_tile "down0" 1)
  183.           (if (null crtlst0)(mode_tile "removelist" 1))
  184.           (action_tile "itemlist" "(do_list \"itemlist\")")
  185.           (action_tile "item" "(setq textstr $value)")
  186.           (action_tile "mdf" "(mdfitem)")
  187.           (action_tile "add" "(additem)")
  188.           (action_tile "del" "(delitem)")
  189.           (action_tile "up" "(upitem)")
  190.           (action_tile "down" "(downitem)")
  191.           (action_tile "itemlist0" "(do_list \"itemlist0\")")
  192.           (action_tile "addlist" "(addlist)")
  193.           (action_tile "removelist" "(removelist)")
  194.           (action_tile "up0" "(upitem0)")
  195.           (action_tile "down0" "(downitem0)")
  196.           (action_tile "pick" "(setq do_what 3)(done_dialog)")
  197.           (action_tile "accept" "(setq result 1)(done_dialog)")
  198.           (action_tile "cancel" "(setq result 0)(done_dialog 0)")
  199.           (start_dialog)
  200.         )
  201.       )
  202.     )
  203.   )
  204.   (unload_dialog DLG_ID)
  205.   (if (and (= result 1) (setq crd (getpoint "\n文本位置:")))
  206.     (if crtlst0
  207.       (progn
  208.         (setq n 0 textstr0 "")
  209.         (repeat (length crtlst0)
  210.           (setq textstr0 (strcat textstr0 (itoa (1+ n)) ". " (nth n crtlst0) "\\P"))
  211.           (setq n (1+ n))
  212.         )
  213.         (vl-string-right-trim "\\P" textstr0)
  214.         (setq kd (getcorner crd "\n段落宽:"))
  215.         (entmake (list '(0 . "MTEXT")'(100 . "AcDbEntity")'(100 . "AcDbMText")(cons 10 crd)(cons 40 (* scl 3.5))(cons 41 (- (car kd)(car crd)))'(71 . 1)'(72 . 5)(cons 1 textstr0)'(8 . "TEXT")))
  216.         (entmake (list '(0 . "TEXT")'(10 0.0 0.0 0.0)(cons 40 (* scl 5.0))'(72 . 1)'(73 . 1)(cons 11 (list (/ (+ (car crd)(car kd)) 2.0) (+ (cadr crd)(* 4.0 scl)) 0.0))'(1 . "技术要求")'(8 . "TEXT")))
  217.       )
  218.       (entmake (list '(0 . "TEXT")(cons 10 crd)(cons 40 (* scl 3.5))(cons 1 textstr)'(8 . "TEXT")))
  219.     )
  220.   )
  221.   (setq *error* syserr)
  222.   (command "undo" "e")
  223.   (princ)
  224. )

本帖子中包含更多资源

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

x

点评

正好需要!谢谢了  发表于 2015-7-30 10:11

评分

参与人数 9明经币 +9 金钱 +90 收起 理由
趣意人生 + 1 赞一个!
chlh_jd + 1 + 10 很给力!
lidaxiu + 1 很给力!
仲文玉 + 1 + 30 很给力!
ALXY + 10 很给力!
langjs + 1 我们要风一年前的作品!
yjr111 + 1 + 10 十几年前就如此了得,佩服!
669423907 + 1 风的高作,值得顶起!
ZZXXQQ + 2 + 30 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2023-3-10 00:23:29 | 显示全部楼层
本帖最后由 Bdj 于 2023-3-10 00:24 编辑

这个配置文件里面的内容像这样的是怎么回事?又可以解答的吗?

本帖子中包含更多资源

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

x
发表于 2017-8-7 22:27:04 | 显示全部楼层
还是希望技术要求库的内容能分类,要不然找起来太麻烦了
发表于 2012-2-21 22:43:42 | 显示全部楼层

非常不错哦
谢谢了
发表于 2012-2-21 22:45:08 | 显示全部楼层
我还是沙发呢!!
荣幸!!
 楼主| 发表于 2012-2-21 23:17:10 | 显示全部楼层
前面几个对表进行操作的函数可以做成通用函数,分别是:
delsame  删除表中相同的项
fwrdlist 元素之前所有元素的列表
backlist 元素之后所有元素的列表
swapfwrd 表中元素向前交换
swapback 表中元素向后交换
add_item 在表中当前位置添加元素
del_item 删除表中当前元素
mdfylist 修改表中当前元素
发表于 2012-2-21 23:32:15 | 显示全部楼层
虽然用不到,但很支持分享源码!
发表于 2012-2-21 23:46:45 | 显示全部楼层
风吹到那里,我就跟到那里
发表于 2012-2-22 10:34:40 | 显示全部楼层
本帖最后由 langjs 于 2012-2-22 10:35 编辑

我们要风一年前的作品!

点评

一年前的有“粗糙度”,在明经里可以找到。两年前的没有,三年前的也没有……,直到十几年前才有。  发表于 2012-2-23 19:59
发表于 2012-2-22 10:39:16 | 显示全部楼层
感谢版主,跟“风”开始啦~
发表于 2012-2-22 10:58:06 | 显示全部楼层
风大侠的程序非常不错,不过不知最后生成的文字能否换成单行文字?谢谢
发表于 2012-2-22 10:58:37 | 显示全部楼层
风大侠的程序非常不错,不过不知最后生成的文字能否换成单行文字?谢谢
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-6 07:13 , Processed in 0.250769 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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