各位大哥帮忙看一下程序。
在各位大哥的指点下我完成了第一个程序，现在程序是能运行了，但是需要大家帮忙瘦身一下。软件的功能是对从VISIO导过来的CAD文件进行处理，部分字进行分层，部分线该为指定宽度的多义线。(defun c:test (/ ss )<BR> (setvar "cmdecho" 0)<BR> (command "undo" "be") ;<BR> (command ".LAYER" "S" "ANT" "") ;选择ANT层为当前层。<BR> (command "fillmode" "1")
(setq ss (ssget "X" '((0 . "MTEXT") (8 . "ANT"))))；选择ANT层的多行字体<BR> (setq i 0) <BR> (while (< i (sslength ss))<BR> (command "explode" (ssname ss i)) ;炸开<BR> (setq i (1+ i))<BR> )
(setq lay1 "0" lay2 "编号" lay3 "DIVIDER" lay4 "COUPLER")<BR> (command "_.layer" "m" lay2 "m" lay3 "m" lay4 "") ;建层（主要是我不知道如何对错误的判断，如：没有DIVIDER的层，所以建了一层）<BR> (setq layern "DIVIDER")
(command "_LAYER" "S" layern "")<BR> (command "_mtext" "5,5" "h" "0.00001" "w" "0.00001" "1" "");写个文本，也是和上面一样，不知道如何处理异常。<BR> (setq ss (ssget "X" (list '(0 . "MTEXT") (cons 8 layern))))<BR> (setq i 0)<BR> (while (< i (sslength ss))<BR> (command "explode" (ssname ss i)) ;炸开<BR> (setq i (1+ i))<BR> )<BR> (setq ss(ssget "x" (list '(0 . "TEXT") (cons 8 layern)))) ;把这一层的数字开头的放到“编号”层。<BR> (setq sn(if ss (sslength ss) 0))<BR> (setq i 0)<BR> (while (< i sn)<BR> (setq si(ssname ss i))<BR> (setq wText(cdr(assoc 1 (entget si))))<BR> (setq c1(substr wText 1 1))<BR> (if(and(> c1 "/")(< c1 ":"))<BR> (command "_.change" si "" "p" "la" lay1 "")<BR> (command "_.change" si "" "p" "la" lay2 "")<BR> )<BR> (setq i(1+ i))<BR> )
<BR> (setq layern "COUPLER") ；对COUPLER的层做同样的处理。<BR> (command "_LAYER" "S" layern "")<BR> (setq ss (ssget "X" (list '(0 . "MTEXT") (cons 8 layern))))<BR> (setq i 0)<BR> (while (< i (sslength ss))<BR> (command "explode" (ssname ss i))<BR> (setq i (1+ i))<BR> )<BR> (setq ss(ssget "x" (list '(0 . "TEXT") (cons 8 layern))))<BR> (setq sn(if ss (sslength ss) 0))<BR> (setq i 0)<BR> (while (< i sn)<BR> (setq si(ssname ss i))<BR> (setq wText(cdr(assoc 1 (entget si))))<BR> (setq c1(substr wText 1 1))<BR> (if(and(> c1 "/")(< c1 ":"))<BR> (command "_.change" si "" "p" "la" lay1 "")<BR> (command "_.change" si "" "p" "la" lay2 "")<BR> )<BR> (setq i(1+ i))<BR> )<BR> <BR> (command ".LAYER" "S" "0" "") ;选择0层 炸开其他的所有多行文字。<BR> (setq ss (ssget "X" '((0 . "MTEXT"))))<BR> (setq i 0) <BR> (while (< i (sslength ss))<BR> (command "explode" (ssname ss i))<BR> (setq i (1+ i))<BR> )
(setq ff (getfiled "请选择数据文件：" "C:/LISP" "txt" 8));读取外部数据 获取图层名称和多义线的宽度，根据这些数据把该层的线该为相应的宽度的多义线。<BR> (setq f (open ff "r"))
(while (setq lname (read-line f))<BR> (setq wid (read-line f))<BR> (command "_.layer" "m" lname "")<BR> (command "line" "5,5" "5,5" "")<BR> (setq ss (ssget "X" (list '(0 . "line,arc,*POLYLINE") (cons 8 lname))))<BR> (setq i 0) ;<BR> (while (< i (sslength ss))<BR> (setq ssa-ent (ssname ss i))<BR> (setq ent-p (cdr (assoc 0 (entget ssa-ent))))<BR> (if (not (null ent-p)) ;<BR> (if (or (= ent-p "POLYLINE") (= ent-p "LINE")) ;<BR> (command "pedit" ssa-ent "y" "w" wid "j" ss "" "")<BR> (command "pedit" ssa-ent "w" wid "j" ss "" "")<BR> ))<BR> (setq i (1+ i))<BR> )<BR> )<BR> (close f)<BR> (command "undo" "e")<BR> (command "zoom" "a" "") ;<BR> (setvar "cmdecho" 1)<BR> (princ)<BR>)
不知是否行？(defun c:test (/ ss)
(setvar "cmdecho" 0)
(command "undo" "be")
(mkla "ANT" 7)
(command "fillmode" "1")
(setq ss (ssget "X" '((0 . "MTEXT") (8 . "ANT"))))
(setq i 0)
(while (< i (sslength ss))
(command "explode" (ssname ss i))
(setq i (1+ i))
)
(mkla "编号" 7)
(mkla "COUPLER" 7)
(mkla "DIVIDER" 7)
(command "_mtext" "5,5" "h" "0.00001" "w" "0.00001" "1" "")
;写个文本，也是和上面一样，不知道如何处理异常。
(setq ss (ssget "X" (list '(0 . "MTEXT") (cons 8 "DIVIDER"))))
(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 "DIVIDER"))))
(setqsn (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))
)
(mkla "COUPLER" 7)
(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))))
(setqsn (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" "")
(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)
)
(defun mkla (name color)
(If (= (Tblsearch "layer" name) nil)
(Command "layer" "m" name "c" color name "")
(Command "layer" "t" name "s" name "c" color name "")
)
) 我觉的程序能达到要求就行,没有必要刻意去瘦身. 我只是想通过瘦身提高自己的水平，现在程序是小，如果是大的呢？谢谢楼上的指点，我看了一下，我又点明白你的意思了，谢谢你的指点。
页:
[1]