[编程申请]：批量归层的程序

thx · 发表于 2005-7-5 09:34:08

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

需要这样一个程序：比如层名为3001，程序将改层改为38，颜色改为5，线形改为23601，线宽改为2，也就是这样的的格式：
初始层  层  颜色  线宽线形
5201    42    25       2    23654
5211    43    2          1       21401
…… …… …… …… ……
运行之后能全部改为标准代码，请高手帮忙一下
线形库定义为：500.lin

eachy · 发表于 2005-7-5 11:18:30

只是改名称？

xyp1964 · 发表于 2005-7-5 12:43:51

最初由 thx 发布
[B]需要这样一个程序：比如层名为3001，程序将改层改为38，颜色改为5，线形改为23601，线宽改为2，也就是这样的的格式：
初始层  层  颜色  线宽线形
5201    42    25       2    23654
5211    43    2... [/B]

看不出任何规律！只能自己慢慢改了，呵呵……

thx · 发表于 2005-7-5 13:39:57

不是啊，拜托两位斑竹，我的意思就是：假如说原始层为5201，那么就把他的名称改为25，颜色也改为25，线形改为23654，线宽改为2，有一个标准的码表，码表的格式为：
初始层层颜色线宽线形
5201 42 25 2 23654
5211 43 2 1 21401
…… …… …… …… ……

运行程序后，可以读取这个码表然后据此码表相对应的改变，或者直接写到程序里也可以，你可以只写假定码表的一行，后面的我继续加，这样我的意思说明白了吗？

登录/注册后可看大图

eachy · 发表于 2005-7-5 19:36:29

把码表文件贴上来
BTW：你用什么版本CAD？

xyp1964 · 发表于 2005-7-5 21:36:48

未经测试：
[php](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在acad.lsp中增加(load"xyp_lib")
2.在每个程序内增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
5.将xyp_lib.vlx文件直接拽到cad屏幕
★通用函数下载地址：[/COLOR]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661|;

;;;批量归层--码表文件
(defun c:test ()
  (cmdla0)
  (alert (strcat
   "数据格式:"
   "\n初始层层颜色线宽线形"
   "\n初始层层颜色线宽线形"
   "\n初始层层颜色线宽线形"
   "\n初始层层颜色线宽线形"
   "\n..."
   "\n..."
   )
  )
  (while (not
   (setq tn (getfiled "码表文件(txt;dat;*)" "" "txt;dat;*" 2))
   )
  )
  (setq fle (findfile tn))
  (if (not fle)
(setq fle (getfiled "请选择码表文件" "" "txt;dat;*" 8))
  )
  (if fle
(progn
   (setq fn (open fle "r"))
   (while (setq pt (read-line fn))
(setq lst (read (strcat "(" pt ")"))
      la-old (car lst)
      lst (cdr lst)
      la-new (car lst)
      lst (cdr lst)
      co    (car lst)
      lst (cdr lst)
      l-wide (car lst)
      lst (cdr lst)
      l-type (car lst)
)
(if (setq ss (ssget "X" (list (cons 8 la-old))))
   (progn
      (princ ".")
      (mkla la-new (atof co))
      (jzxx l-type "500.lin")
      (command "change"
      ss
      ""
      "p"
      "la"
      la-new
      "c"
      (atof co)
      "lt"
      l-type
      "lw"
      l-wide
      ""
      )
   )
)
   )
   (close fn)
)
(princ "\n未选择数据文件，退出")
  )
  (cmdla1)
)[/php]

thx · 发表于 2005-7-6 09:13:26

刚刚试了一下xyp1964的LISP程序，好象没有反应，我也加载了通用函数，就是定义的线型库我改名字了，但是我把程序的也相应的改过来了，我把线型库文件放到CAD安装目录里是不是就行了？还是我做得不对，我用的CAD从R14到2004都有，斑竹你看怎么方便怎么来，我把定义的线型库、码表和一个DXF文件上传，麻烦斑竹调试一下，DXF里只有几个层而已，说到这，想起来晓东工具箱里有个POLYLINE与LWPOLYLINE互相转的功能，我这个DXF里的POLYLINE就不能转成LWPOLYLINE，不知道什么原因？难道是有Z值就不能转吗？（定义的线型库只是让他具有线型的名字，其实并没有线型）

xyp1964 · 发表于 2005-7-6 13:59:10

[FONT=courier new](load "xyp_lib")
;|加载通用函数(可在签名栏直接下载)
如果已经下载xyp_lib并放到搜索路径下可以不再下载!
利用以下任何一种方式即可加载和运行通用函数内的所有子程序：
1.在acad.lsp中增加(load"xyp_lib")
2.在每个程序内增加(load"xyp_lib")
3.在command下，输入(load"xyp_lib")
4.在菜单.mnl中增加(load"xyp_lib")
5.将xyp_lib.vlx文件直接拽到cad屏幕
[COLOR=red] ★通用函数下载地址：[/COLOR][url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]|;
;;;批量归层--码表文件
(defun c:test165 ()
(cmdla0)
(while (not (setq tn (getfiled "码表文件(txt)" "" "txt" 2))))
(setq fle (findfile tn))
(if (not fle) (setq fle (getfiled "请选择码表文件" "" "txt" 8)))
(if fle
(progn
(setq f-open (open fle "r")
pt (read-line f-open)
)
(while (setq pt (read-line f-open))
(setq lst (read (strcat "(" pt ")")))
(setq la-old (rots (nth 0 lst) 2 0)
la-new (rots (nth 1 lst) 2 0)
co (nth 2 lst)
l-wide (nth 3 lst)
l-type (rots (nth 4 lst) 2 0)
)
(if (setq ss (ssget "X" (list (cons 8 la-old))))
(progn
(princ ".")
(mkla la-new co)
(jzxx l-type "2500-dgnlintp")
(command "change" ss "" "p" "la"
la-new "c" co "lt" l-type "lw"
l-wide ""
)
)
)
)
(close f-open)
)
(princ "\n未选择数据文件，退出")
)
(cmdla1)
)[/FONT]

[FONT=courier new](load "xyp_lib") 
;|加载通用函数(可在签名栏直接下载) 
如果已经下载xyp_lib并放到搜索路径下可以不再下载! 
利用以下任何一种方式即可加载和运行通用函数内的所有子程序： 
1.在acad.lsp中增加(load"xyp_lib") 
2.在每个程序内增加(load"xyp_lib") 
3.在command下，输入(load"xyp_lib") 
4.在菜单.mnl中增加(load"xyp_lib") 
5.将xyp_lib.vlx文件直接拽到cad屏幕 
[COLOR=red] ★通用函数下载地址：[/COLOR][url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]|; 
 
;;;批量归层--码表文件 
(defun c:test165 () 
  (cmdla0) 
  (while (not (setq tn (getfiled "码表文件(txt)" "" "txt" 2)))) 
  (setq fle (findfile tn)) 
  (if (not fle) (setq fle (getfiled "请选择码表文件" "" "txt" 8))) 
  (if fle 
    (progn 
      (setq f-open (open fle "r") 
            pt           (read-line f-open) 
      ) 
      (while (setq pt (read-line f-open)) 
        (setq lst (read (strcat "(" pt ")"))) 
        (setq la-old (rots (nth 0 lst) 2 0) 
              la-new (rots (nth 1 lst) 2 0) 
              co     (nth 2 lst) 
              l-wide (nth 3 lst) 
              l-type (rots (nth 4 lst) 2 0) 
        ) 
        (if (setq ss (ssget "X" (list (cons 8 la-old)))) 
          (progn 
            (princ ".") 
            (mkla la-new co) 
            (jzxx l-type "2500-dgnlintp") 
            (command "change"  ss   ""  "p" "la" 
                     la-new  "c" co "lt"  l-type "lw" 
                     l-wide  "" 
                    ) 
          ) 
        ) 
      ) 
      (close f-open) 
    ) 
    (princ "\n未选择数据文件，退出") 
  ) 
  (cmdla1) 
)[/FONT]

thx · 发表于 2005-7-6 17:22:36

为什么运行后还是一点都没有改变呢？我先把线型库拷到CAD安装目录，然后加载XYP_LIB.VLX和编写的test.lsp程序，打开图形运行程序，选择码表之后就没有反应了，然后我又把线型库加载了一遍，还是不行，难道我操作错误了吗？

xyp1964 · 发表于 2005-7-6 19:41:57

码表有乱码！！！
解决办法：将其内容复制到一个新文件中，删除原文件！

eachy · 发表于 2005-7-6 22:57:55

游客，如果您要查看本帖隐藏内容请回复

文件下载见签名中的“"我的程序"

注意：码表文件必须为纯文本格式，不能含有编码。

thx · 发表于 2005-7-8 08:07:15

谢谢，不知道怎么感谢二位斑竹，有机会来大连的话，请你们吃饭：）
QQ：1812968

账号		自动登录	找回密码
密码			立即注册

[编程申请]：批量归层的程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [编程申请]：批量归层的程序

浏览过的版块