如何使用LISP程序读入已编写好的记事本文档来建立图层

pchuangzmx

1.使用记事本编写好自已想要建立的图层名称、颜色、线型、线宽、打印比例。
2.如何编写LISP程序读入此命名的记事本文档，且按记事本里编写好名称来建立绘图图层?

xiaolong1487

思路是这样，先读文本文件（注意格式），生成表。再由表内定义来建图层！

xiaolong1487

这个是test.txt的内容，图层名，颜色。需要什么自己加，自己改
a001 1
a002 2
a003 3

2. ;;84.17 [功能] 读文本文件到表 (快于 AutoLISP read-line函数)
   
3. ;;用法: (vldos-readfile FilenameToRead[STRING] )
   
4. ;;  参数1: 文本文件全路径名. (包括后缀名)
   
5. ;;        只有文本文件才能返回正确结果.
   
6. ;;返回值: 返回包括文件内容的表 or NIL
   
7. (Defun vldos-readfile
   
8.         (Fil / string->list FilObj FilPth FilSys OpnFil All)
   
9.   (Defun string->list (String / ID Rtn)
   
10.     (if        (null (setq ID (vl-string-search "\r\n" String)))
    
11.       (setq Rtn (list String))
    
12.       (progn
    
13.                                 (while ID
    
14.                                         (setq        Rtn    (cons (substr String 1 ID) Rtn)
    
15.                                                 String (substr String (+ 3 ID))
    
16.                                                 ID     (vl-string-search "\r\n" String)
    
17.                                         )
    
18.                                 )
    
19.                                 (setq Rtn (reverse (cons String Rtn)))
    
20.       )
    
21.     )
    
22.     Rtn
    
23.   )
    
24.   (if (AND (setq FilPth (findfile Fil))
    
25.                                 (setq FilSys (vlax-create-object "Scripting.FileSystemObject"))
    
26.       )
    
27.     (progn
    
28.       (setq FilObj (vlax-invoke FilSys "GetFile" FilPth)
    
29.                                 OpnFil (vlax-invoke FilObj "OpenAsTextStream" 1 0)
    
30.                                 All           (string->list (vlax-invoke OpnFil "readall"))
    
31.       )
    
32.       (vlax-invoke OpnFil "Close")
    
33.       (vlax-release-object OpnFil)
    
34.       (vlax-release-object FilObj)
    
35.       (vlax-release-object FilSys)
    
36.     )
    
37.   )
    
38.   All
    
39. )
    
40. 
    
41. ;|
    
42. ;;http://www.xdcad.net/forum/thread-669166-1-2.html By XDSoft
    
43. 功能 对字符串进行正则表达式匹配测试.
    
44. pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \\号要用\\\\替代.
    
45. str = 字符串
    
46. key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.
    
47. "m"多行模式（Multiline），以上几个关键字可以组合使用，或用 "".
    
48. 返回: 返回匹配的字符列表，或无一匹配返回nil
    
49. |;
    
50. ;;47.1 [功能] 字符串分割(正则表达式)
    
51. (defun XD::String:RegExpS (pat str key / end keys matches x)
    
52.   (if (not *xxvbsexp)
    
53.     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
    
54.   )
    
55.   (vlax-put *xxvbsexp 'Pattern pat)
    
56.   (if (not key)
    
57.     (setq key "")
    
58.   )
    
59.   (setq key (strcase key))
    
60.   (setq        keys '(("I" "IgnoreCase")
    
61.                                                                 ("G" "Global")
    
62.                                                                 ("M" "Multiline")
    
63.                                                         )
    
64.   )
    
65.   (mapcar
    
66.     '(lambda (x)
    
67.        (if (wcmatch key (strcat "*" (car x) "*"))
    
68.                                  (vlax-put *xxvbsexp (read (cadr x)) 0)
    
69.                                  (vlax-put *xxvbsexp (read (cadr x)) -1)
    
70.        )
    
71.      )
    
72.     keys
    
73.   )
    
74.   (setq matches (vlax-invoke *xxvbsexp 'Execute str))
    
75.   (vlax-for x matches (setq end (cons (vla-get-value x) end)))
    
76.   (reverse end)
    
77. )
    
78. 
    
79. (defun c:ts ()
    
80.         (if (setq lst (vldos-readfile "c:\\test.txt"))
    
81.                 (progn
    
82.                         (foreach str lst
    
83.                                 (setq lst1 (xd::string:regexps "[^\\s]+" str ""))
    
84.                                 (command "-layer" "n" (car lst1) "c" (cadr lst1) (car lst1) "" )
    
85.                         )
    
86.                 )
    
87.         )
    
88. )

;;84.17 [功能] 读文本文件到表 (快于 AutoLISP read-line函数)<br /> ;;用法: (vldos-readfile FilenameToRead[STRING] )<br /> ;;  参数1: 文本文件全路径名. (包括后缀名)<br /> ;;        只有文本文件才能返回正确结果.<br /> ;;返回值: 返回包括文件内容的表 or NIL<br /> (Defun vldos-readfile<br />         (Fil / string->list FilObj FilPth FilSys OpnFil All)<br />   (Defun string->list (String / ID Rtn)<br />     (if        (null (setq ID (vl-string-search "\r\n" String)))<br />       (setq Rtn (list String))<br />       (progn<br />                                 (while ID<br />                                         (setq        Rtn    (cons (substr String 1 ID) Rtn)<br />                                                 String (substr String (+ 3 ID))<br />                                                 ID     (vl-string-search "\r\n" String)<br />                                         )<br />                                 )<br />                                 (setq Rtn (reverse (cons String Rtn)))<br />       )<br />     )<br />     Rtn<br />   )<br />   (if (AND (setq FilPth (findfile Fil))<br />                                 (setq FilSys (vlax-create-object "Scripting.FileSystemObject"))<br />       )<br />     (progn<br />       (setq FilObj (vlax-invoke FilSys "GetFile" FilPth)<br />                                 OpnFil (vlax-invoke FilObj "OpenAsTextStream" 1 0)<br />                                 All           (string->list (vlax-invoke OpnFil "readall"))<br />       )<br />       (vlax-invoke OpnFil "Close")<br />       (vlax-release-object OpnFil)<br />       (vlax-release-object FilObj)<br />       (vlax-release-object FilSys)<br />     )<br />   )<br />   All<br /> )<br /> <br /> ;|<br /> ;;http://www.xdcad.net/forum/thread-669166-1-2.html By XDSoft<br /> 功能 对字符串进行正则表达式匹配测试. <br /> pat = 正则表达式模式 ,对应vbs正则表达式的模式(expression)。说明: \\号要用\\\\替代.<br /> str = 字符串<br /> key = "i" "g" "m" , "i"不区分大小写（Ignorecase）,"g"全局匹配（Global）.<br /> "m"多行模式（Multiline），以上几个关键字可以组合使用，或用 "".<br /> 返回: 返回匹配的字符列表，或无一匹配返回nil<br /> |;<br /> ;;47.1 [功能] 字符串分割(正则表达式)<br /> (defun XD::String:RegExpS (pat str key / end keys matches x)<br />   (if (not *xxvbsexp)<br />     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))<br />   )<br />   (vlax-put *xxvbsexp 'Pattern pat)<br />   (if (not key)<br />     (setq key "")<br />   )<br />   (setq key (strcase key))<br />   (setq        keys '(("I" "IgnoreCase")<br />                                                                 ("G" "Global")<br />                                                                 ("M" "Multiline")<br />                                                         )<br />   )<br />   (mapcar<br />     '(lambda (x)<br />        (if (wcmatch key (strcat "*" (car x) "*"))<br />                                  (vlax-put *xxvbsexp (read (cadr x)) 0)<br />                                  (vlax-put *xxvbsexp (read (cadr x)) -1)<br />        )<br />      )<br />     keys<br />   )<br />   (setq matches (vlax-invoke *xxvbsexp 'Execute str))<br />   (vlax-for x matches (setq end (cons (vla-get-value x) end)))<br />   (reverse end)<br /> )<br /> <br /> (defun c:ts ()<br />         (if (setq lst (vldos-readfile "c:\\test.txt"))<br />                 (progn<br />                         (foreach str lst<br />                                 (setq lst1 (xd::string:regexps "[^\\s]+" str ""))<br />                                 (command "-layer" "n" (car lst1) "c" (cadr lst1) (car lst1) "" )<br />                         )<br />                 )<br />         )<br /> )

pchuangzmx

谢谢你的建义及实例程序，但我还是没理解你给我写的这段程序，我先看明白后自已再偿试来学习做一遍，非常感谢

davide888

论坛有人发过的;;创建图层
(defun C:xwy( / tt f txt tm cl xx xk)
(setvar "cmdecho" 0)
(setq tt (findfile "定义图层.txt"))
(setq f (open tt "r"))
(read-line f )
(while (setq txt (read-line f))
       (setq tm (substr txt 1 20))
       (setq cl (substr txt 21 3))
       (setq xx (substr txt 29 10))
       (setq xk (substr txt 44 4))
(command "_layer" "n" tm "c" cl tm "l" xx tm "lw" xk tm "") )
   (PRINC "图层加载OK"))



文本名称  定义图层.txt
//模板图层          颜色    线型           线宽
标注                    008     CONTINUOUS     0.10
填充                    250     CONTINUOUS     0.05


因为是读取字符位置，所以要对齐位置。

xiaolong1487

pchuangzmx 发表于 2017-10-25 07:50
谢谢你的建义及实例程序，但我还是没理解你给我写的这段程序，我先看明白后自已再偿试来学习做一遍，非常感 ...

这个是test.txt的内容，图层名，颜色。需要什么自己加，自己改
a001 1
a002 2
a003 3

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

趣意人生

感谢楼主的无私分享 谢谢

ZYX2129

感谢楼主的无私分享 谢谢