（求助）高手请进 ，属性图框生成目录问题（源码优化）
本帖最后由 kele99kele 于 2013-7-24 11:54 编辑程序已改编好，源程序见http://bbs.mjtd.com/thread-96502-1-1.html，现在的问题是图号前必须有非数字的字符，否则程序中断，如果有非数字的字符则正常显示，如何在没有前置字符的情况下正确排序，求大神解决
(defun c:mml (/ a ch date en file i j lst lst1 lst2 pt1 snap x0 y0 zoom1)
(setvar "cmdecho" 0)
(setvar "filedia" 0)
(setq file (open "c:\\样板文件x.txt" "w"))
(write-line "图名 C040000" file)
(write-line "图号 C040000" file)
(close file)
(setq ss (ssget '((0 . "*insert"))))
(setq yb "c:\\样板文件x.txt")
(setq ml "c:\\图纸目录x.txt")
(vl-cmdf "-attext" "o" ss "" "sdf" yb ml)
(setvar "filedia" 1)
(scml11)
(princ)
)
(defun scml11 ()
(setvar "cmdecho" 0)
(setvar "filedia" 0)
(command ".UNDO" "BE") ; 设置undo起点
(setq snap (getvar "osmode")) ; 关闭捕捉
(setvar "osmode" 0)
(command "style" "tssd_dimension" "thz")
(if (= (tblsearch "layer" "txt") nil) ; 新建个文字层
(command "layer" "N" "txt" "C" 7 "txt" "")
)
(if (= (tblsearch "layer" "see") nil) ; 新建个细线成
(command "layer" "N" "see" "C" 3 "see" "")
)
(setq file (open "c:/图纸目录x.TXT" "r")) ; 读取临时txt的内容
(setq date (read-line file))
(setq date2 '())
(setq lst '())
(while date
(setq date2 (read (strcat "(" date ")")))
(setq lst (cons date2 lst))
(setq date (read-line file))
)
(close file)
;(vl-file-delete "c:\\图纸目录x.TXT")
;(setq lst (reverse lst))
(setq i 0)
(setq lst1 '()
lst2 '()
)
(while (< i (length lst))
(setq lst1 (list (vl-symbol-name (car (nth i lst))) (vl-symbol-name (cadr (nth i lst)))))
(setq lst2 (cons lst1 lst2))
(setq i (+ i 1))
)
(setq lst lst2)
(setq lst (vl-sort lst
(function (lambda (e1 e2)
(< (cadr e1) (cadr e2))))))
(setq apnt (getpoint "\n选择目录放置点："))
(setqapnt_x (car apnt)
apnt_y (cadr apnt)
)
(setq pt1 (list (- apnt_x 5) (- apnt_y 5)))
(setq pt2 (list (+ (+ apnt_x (* (fix (/ (length lst) 28)) 110)) 100) (+ apnt_y 237)))
(setq i 0)
(while (< i (length lst))
(if (= (rem i 28) 0)
(progn
(setq x0 (+ apnt_x (* (fix (/ i 28)) 110))
y0 apnt_y
)
(hzbg x0 y0) ; 绘制图纸目录的格式
(setq j 0)
)
)
(setq a (nth i lst)) ; 下面程序写入内容
(setq pt1 (list (+ x0 500) (- (+ y0 22000) (* j 800))))
(command "text" "j" "mc" pt1 350 0 (itoa (+ i 1)))
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(setq pt1 (list (+ x0 1200) (- (+ y0 22000) (* j 800))))
(command "text" "j" "ml" pt1 350 0 (car a))
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(setq pt1 (list (+ x0 7750) (- (+ y0 22000) (* j 800))))
(command "text" "j" "mc" pt1 350 0 (cadr a))
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(setq pt1 (list (+ x0 9000) (- (+ y0 22000) (* j 800))))
(command "text" "j" "mc" pt1 350 0 "详图")
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(setq i (+ i 1))
(setq j (+ j 1))
)
(command ".UNDO" "E") ; 设置undo终点
(setvar "filedia" 1)
(setvar "osmode" snap)
(princ)
)
(defun hzbg (x0 y0 / en i pt1 pt2 pt3)
(setq pt1 (list (+ x0 0) (+ y0 23200))
pt2 (list (+ x0 9500) y0)
)
(command ".rectang" pt1 pt2)
(setq en (entlast))
(command ".change" en "" "p" "la" "see" "")
(command "_pedit" en "w" 0.5 "")
(setq pt1 (list (+ x0 0) (+ y0 22400))
pt2 (list (+ x0 9500) (+ y0 22400))
)
(command ".line" pt1 pt2 "")
(setq en (entlast))
(command ".change" en "" "p" "la" "see" "")
(setq i 0)
(while (<= i 26)
(setq pt1 (list (+ x0 0) (- (+ y0 21600) (* i 800)))
pt2 (list (+ x0 9500) (- (+ y0 21600) (* i 800)))
pt3 (list (+ x0 0) (+ y0 20800))
)
(command ".line" pt1 pt2 "")
(setq en (entlast))
(command ".change" en "" "p" "la" "see" "c" "1" "")
(command ".copy" en "" pt1 pt3)
(setq i (+ i 1))
)
(setq pt1 (list (+ x0 1000) (+ y0 0))
pt2 (list (+ x0 1000) (+ y0 23200))
)
(command ".line" pt1 pt2 "")
(setq en (entlast))
(command ".change" en "" "p" "la" "see" "c" "1" "")
(setq pt1 (list (+ x0 7000) (+ y0 0))
pt2 (list (+ x0 7000) (+ y0 23200))
)
(command ".line" pt1 pt2 "")
(setq en (entlast))
(command ".change" en "" "p" "la" "see" "c" "1" "")
(setq pt1 (list (+ x0 8500) (+ y0 0))
pt2 (list (+ x0 8500) (+ y0 23200))
)
(command ".line" pt1 pt2 "")
(setq en (entlast))
(command ".change" en "" "p" "la" "see" "c" "1" "")
(command "textstyle" "tssd_dimension")
(setq pt1 (list (+ x0 500) (+ y0 22800)))
(command "text" "j" "mc" pt1 350 0 "序 号")
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(setq pt1 (list (+ x0 4000) (+ y0 22800)))
(command "text" "j" "mc" pt1 350 0 "图 名")
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(setq pt1 (list (+ x0 7750) (+ y0 22800)))
(command "text" "j" "mc" pt1 350 0 "图 号")
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(setq pt1 (list (+ x0 9000) (+ y0 22800)))
(command "text" "j" "mc" pt1 350 0 "图 幅")
(setq en (entlast))
(command ".change" en "" "p" "la" "txt" "")
(princ)
)
我一直用自己写的http://bbs.mjtd.com/thread-96636-1-1.html
来统计图纸，你可以参考一下。 谢谢楼上同志，我是基础太差，想在这个程序中先找找问题，以便学习
这是从网上下的，我认为这个写目录最简单，可惜我不会添加其他属性
本帖最后由 BUBUBA918 于 2013-7-24 20:51 编辑;此程序为根据图形内图框，自动写图形的目录。
;
(defun c:mul(/ sel m tf th tm selm ss sst ssm k p1 p2)
;选择图框
(setqsel (ssget "x" (list (cons -4 "<or") (cons 2 "图框A0") (cons 2 "图框A1") (cons 2 "图框A2") (cons -4 "or>"))))
(if (= sel nil)
(progn
(princ "\n图中无有效图框.")
(quit)
) )
(setq m (sslength sel))
(setq sst '() k 1)
(while (>= (setq m (1- m)) 0)
(progn
(setq selm (ssname sel m))
(setq ss (cdr (assoc 2 (entget selm))))
;提取图幅信息
(setq tf (substr ss 5))
(repeat 2
(progn
(setq selm (entnext selm))
(setq ss (entget selm))
;提取图号，图名信息。
(if (= (cdr (assoc 2 ss)) "图号") (setq th (cdr (assoc 1 ss))))
(if (= (cdr (assoc 2 ss)) "图名")
(progn
(setq tm (cdr (assoc 1 ss)))
(if (< k (strlen tm)) (setq k (strlen tm)))
)
)
)
)
(setq ssm (list th tm tf))
(setq sst (cons ssm sst))
)
)
;图名，图号，图幅信息提取完成，存放在串列sst中。下面对串列sst进行排序。
(vl-load-com)
(setq sst (vl-sort sst (function (lambda (e1 e2) (< (atoi (car e1)) (atoi (car e2)))))))
(setq svar (getvar "osmode"))
(setvar "osmode" 0)
;写表头
(setq m (length sst))
(setq p1 (getpoint "输入目录表格的左上角角点"))
(setq p2 (polar p1 (* 1.5 pi) (+ 1450 (* m 800))))
(command "layer" "N" "TAB" "S" "TAB" "")
(command "_line" p1 (polar p1 0 11800) "")
(command "_line" p2 p1 "")
(command "_copy" (ssget "L") "" "m" p1 (polar p1 0 800) (polar p1 0 3500) (polar p1 0 10000)(polar p1 0 11800) "")
(setq p2 (polar p1 (* 1.5 pi) 650))
(command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 400) "500" "0" "序")
(command "_text" "s" "TSSD_Rein" "J" "c" (polar (polar p2 (* 1.5 pi) 650) 0 400) "500" "0" "号")
(setq p2 (polar p1 (* 1.5 pi) 975))
(command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 2150) "500" "0" "图 号")
(command "_text" "s" "TSSD_Rein" "J" "bl" (polar p2 0 3900) "500" "0" "图 纸 内 容")
(command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 10900) "500" "0" "图 幅")
(setq p2 (polar p1 (* 1.5 pi) 1450))
(command "_line" p2 (polar p2 0 11800) "")
;写目录的内容
(setq k 1)
(repeat m
(progn
(setq p2 (polar p2 (* 1.5 pi) 650))
(command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 400) "500" "0" k)
(command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 2150) "500" "0" (strcat "结施-" (car (car sst))"/" (itoa m)))
(command "_text" "s" "TSSD_Rein" "J" "BL" (polar p2 0 3900) "500" "0" (cadr (car sst)))
(command "_text" "s" "TSSD_Rein" "j" "c" (polar p2 0 10900) "500" "0" (caddr (car sst)))
(setq p2 (polar p2 (* 1.5 pi) 150))
(command "_line" p2 (polar p2 0 11800) "")
(setq k (1+ k))
(setq sst (cdr sst))
)
)
(setvar "osmode" svar)
(prin1)
)
(prompt "**mul**")
(prin1)
;作者:QQ549476107
;欢迎共同讨论学习
谢谢BUBUBA918，正在测试你上传的程序 能否把你的配套图框上传一套，我对比下变量参数 这是原版的目录和说明 这是我做的图签，可是不会添加提取属性，请斑竹出来改下程序，或说明一下如何增加提取属性 再次感谢BUBUBA918，参考BUBUBA918提供的程序，已将原程序一定程度上改善。 学习一下！
页:
[1]