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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 各位大哥帮忙看一下程序。
返回列表 发新帖
查看: 1433|回复: 3

各位大哥帮忙看一下程序。

[复制链接]
spshchen
发表于 2005-1-27 18:11:00 | 显示全部楼层 |阅读模式
在各位大哥的指点下我完成了第一个程序，现在程序是能运行了，但是需要大家帮忙瘦身一下。软件的功能是对从VISIO导过来的CAD文件进行处理，部分字进行分层，部分线该为指定宽度的多义线。 (defun c:test (/ ss )
(setvar "cmdecho" 0)
(command "undo" "be") ;
(command ".LAYER" "S" "ANT" "") ;选择ANT层为当前层。
(command "fillmode" "1") (setq ss (ssget "X" '((0 . "MTEXT") (8 . "ANT"))))；选择ANT层的多行字体
(setq i 0)
(while (< i (sslength ss))
(command "explode" (ssname ss i)) ;炸开
(setq i (1+ i))
) (setq lay1 "0" lay2 "编号" lay3 "DIVIDER" lay4 "COUPLER")
(command "_.layer" "m" lay2 "m" lay3 "m" lay4 "") ;建层（主要是我不知道如何对错误的判断，如：没有DIVIDER的层，所以建了一层）
(setq layern "DIVIDER") (command "_LAYER" "S" layern "")
(command "_mtext" "5,5" "h" "0.00001" "w" "0.00001" "1" "");写个文本，也是和上面一样，不知道如何处理异常。
(setq ss (ssget "X" (list '(0 . "MTEXT") (cons 8 layern))))
(setq i 0)
(while (< i (sslength ss))
(command "explode" (ssname ss i)) ;炸开
(setq i (1+ i))
)
(setq ss(ssget "x" (list '(0 . "TEXT") (cons 8 layern)))) ;把这一层的数字开头的放到“编号”层。
(setq sn(if ss (sslength ss) 0))
(setq i 0)
(while (< i sn)
(setq si(ssname ss i))
(setq wText(cdr(assoc 1 (entget si))))
(setq c1(substr wText 1 1))
(if(and(> c1 "/")(< c1 ":"))
(command "_.change" si "" "p" "la" lay1 "")
(command "_.change" si "" "p" "la" lay2 "")
)
(setq i(1+ i))
)
(setq layern "COUPLER") ；对COUPLER的层做同样的处理。
(command "_LAYER" "S" layern "")
(setq ss (ssget "X" (list '(0 . "MTEXT") (cons 8 layern))))
(setq i 0)
(while (< i (sslength ss))
(command "explode" (ssname ss i))
(setq i (1+ i))
)
(setq ss(ssget "x" (list '(0 . "TEXT") (cons 8 layern))))
(setq sn(if ss (sslength ss) 0))
(setq i 0)
(while (< i sn)
(setq si(ssname ss i))
(setq wText(cdr(assoc 1 (entget si))))
(setq c1(substr wText 1 1))
(if(and(> c1 "/")(< c1 ":"))
(command "_.change" si "" "p" "la" lay1 "")
(command "_.change" si "" "p" "la" lay2 "")
)
(setq i(1+ i))
)

(command ".LAYER" "S" "0" "") ;选择0层 炸开其他的所有多行文字。
(setq ss (ssget "X" '((0 . "MTEXT"))))
(setq i 0)
(while (< i (sslength ss))
(command "explode" (ssname ss i))
(setq i (1+ i))
) (setq ff (getfiled "请选择数据文件：" "C:/LISP" "txt" 8));读取外部数据 获取图层名称和多义线的宽度，根据这些数据把该层的线该为相应的宽度的多义线。
(setq f (open ff "r")) (while (setq lname (read-line f))
(setq wid (read-line f))
(command "_.layer" "m" lname "")
(command "line" "5,5" "5,5" "")
(setq ss (ssget "X" (list '(0 . "line,arc,*POLYLINE") (cons 8 lname))))
(setq i 0) ;
(while (< i (sslength ss))
(setq ssa-ent (ssname ss i))
(setq ent-p (cdr (assoc 0 (entget ssa-ent))))
(if (not (null ent-p)) ;
(if (or (= ent-p "POLYLINE") (= ent-p "LINE")) ;
(command "pedit" ssa-ent "y" "w" wid "j" ss "" "")
(command "pedit" ssa-ent "w" wid "j" ss "" "")
))
(setq i (1+ i))
)
)
(close f)
(command "undo" "e")
(command "zoom" "a" "") ;
(setvar "cmdecho" 1)
(princ)
)

本帖子中包含更多资源

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

x
回复

使用道具 举报

xyp1964
发表于 2005-1-28 01:33:00 | 显示全部楼层
不知是否行？
  2. (defun c:test (/ ss)
  3.    (setvar "cmdecho" 0)
  4.    (command "undo" "be")
  5.    (mkla "ANT" 7)
  6.    (command "fillmode" "1")
  7.    (setq ss (ssget "X" '((0 . "MTEXT") (8 . "ANT"))))
  8.    (setq i 0)
  9.    (while (< i (sslength ss))
  10.        (command "explode" (ssname ss i))
  11.        (setq i (1+ i))
  12.    )
  13.    (mkla "编号" 7)
  14.    (mkla "COUPLER" 7)
  15.    (mkla "DIVIDER" 7)
  16.    (command "_mtext" "5,5" "h" "0.00001" "w" "0.00001" "1" "")
  17.           ;写个文本，也是和上面一样，不知道如何处理异常。
  18.    (setq ss (ssget "X" (list '(0 . "MTEXT") (cons 8 "DIVIDER"))))
  19.    (setq i 0)
  20.    (while (< i (sslength ss))
  21.        (command "explode" (ssname ss i))
  22.        (setq i (1+ i))
  23.    )
  24.    (setq ss (ssget "x" (list '(0 . "TEXT") (cons 8 "DIVIDER"))))
  25.    (setq  sn (if ss
  26.            (sslength ss)
  27.            0
  28.        )
  29.    )
  30.    (setq i 0)
  31.    (while (< i sn)
  32.        (setq si (ssname ss i))
  33.        (setq wText (cdr (assoc 1 (entget si))))
  34.        (setq c1 (substr wText 1 1))
  35.        (if  (and (> c1 "/") (< c1 ":"))
  36.            (command "_.change" si "" "p" "la" lay1 "")
  37.            (command "_.change" si "" "p" "la" lay2 "")
  38.        )
  39.        (setq i (1+ i))
  40.    )
  41.    (mkla "COUPLER" 7)
  42.    (setq ss (ssget "X" (list '(0 . "MTEXT") (cons 8 layern))))
  43.    (setq i 0)
  44.    (while (< i (sslength ss))
  45.        (command "explode" (ssname ss i))
  46.        (setq i (1+ i))
  47.    )
  48.    (setq ss (ssget "x" (list '(0 . "TEXT") (cons 8 layern))))
  49.    (setq  sn (if ss
  50.            (sslength ss)
  51.            0
  52.        )
  53.    )
  54.    (setq i 0)
  55.    (while (< i sn)
  56.        (setq si (ssname ss i))
  57.        (setq wText (cdr (assoc 1 (entget si))))
  58.        (setq c1 (substr wText 1 1))
  59.        (if  (and (> c1 "/") (< c1 ":"))
  60.            (command "_.change" si "" "p" "la" lay1 "")
  61.            (command "_.change" si "" "p" "la" lay2 "")
  62.        )
  63.        (setq i (1+ i))
  64.    )
  65.    (command ".LAYER" "S" "0" "")
  66.    (setq ss (ssget "X" '((0 . "MTEXT"))))
  67.    (setq i 0)
  68.    (while (< i (sslength ss))
  69.        (command "explode" (ssname ss i))
  70.        (setq i (1+ i))
  71.    )
  72.    (setq ff (getfiled "请选择数据文件：" "C:/LISP" "txt" 8))
  73.    ;;读取外部数据 获取图层名称和多义线的宽度，根据这些数据把该层的线该为相应的宽度的多义线。
  74.    (setq f (open ff "r"))
  75.    (while (setq lname (read-line f))
  76.        (setq wid (read-line f))
  77.        (command "_.layer" "m" lname "")
  78.        (command "line" "5,5" "5,5" "")
  79.        (setq ss (ssget "X"
  80.            (list '(0 . "line,arc,*POLYLINE") (cons 8 lname))
  81.            )
  82.        )
  83.        (setq i 0)
  84.        (while (< i (sslength ss))
  85.            (setq ssa-ent (ssname ss i))
  86.            (setq ent-p (cdr (assoc 0 (entget ssa-ent))))
  87.            (if (not (null ent-p))
  88.   (if (or (= ent-p "POLYLINE") (= ent-p "LINE"))
  89.      (command "pedit" ssa-ent "y" "w" wid "j" ss "" "")
  90.      (command "pedit" ssa-ent "w" wid "j" ss "" "")
  91.   )
  92.            )
  93.            (setq i (1+ i))
  94.        )
  95.    )
  96.    (close f)
  97.    (command "undo" "e")
  98.    (command "zoom" "a" "")
  99.    (setvar "cmdecho" 1)
  100.    (princ)
  101. )
  102. (defun mkla (name color)
  103.    (If (= (Tblsearch "layer" name) nil)
  104.        (Command "layer" "m" name "c" color name "")
  105.        (Command "layer" "t" name "s" name "c" color name "")
  106.    )
  107. )
回复 支持 反对

使用道具 举报

spring
发表于 2005-1-28 02:02:00 | 显示全部楼层
我觉的程序能达到要求就行,没有必要刻意去瘦身.
回复 支持 反对

使用道具 举报

spshchen
 楼主| 发表于 2005-1-28 09:38:00 | 显示全部楼层
我只是想通过瘦身提高自己的水平，现在程序是小，如果是大的呢？谢谢楼上的指点，我看了一下，我又点明白你的意思了，谢谢你的指点。
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-17 18:38 , Processed in 0.159413 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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