明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2795|回复: 9

[已解答] (求助)高手请进 ,属性图框生成目录问题(源码优化)

[复制链接]
发表于 2013-7-24 08:33:13 | 显示全部楼层 |阅读模式
本帖最后由 kele99kele 于 2013-7-24 11:54 编辑

程序已改编好,源程序见http://bbs.mjtd.com/thread-96502-1-1.html,现在的问题是图号前必须有非数字的字符,否则程序中断,如果有非数字的字符则正常显示,如何在没有前置字符的情况下正确排序,求大神解决
  1. (defun c:mml (/ a ch date en file i j lst lst1 lst2 pt1 snap x0 y0 zoom1)
  2.   (setvar "cmdecho" 0)
  3.   (setvar "filedia" 0)
  4.   (setq file (open "c:\\样板文件x.txt" "w"))
  5.   (write-line "图名 C040000" file)
  6.   (write-line "图号 C040000" file)
  7.   (close file)
  8.   (setq ss (ssget '((0 . "*insert"))))
  9.   (setq yb "c:\\样板文件x.txt")
  10.   (setq ml "c:\\图纸目录x.txt")
  11.   (vl-cmdf "-attext" "o" ss "" "sdf" yb ml)
  12.   (setvar "filedia" 1)

  13.   (scml11)
  14.   (princ)
  15. )
  16. (defun scml11 ()
  17.   (setvar "cmdecho" 0)
  18.   (setvar "filedia" 0)
  19.   (command ".UNDO" "BE")         ; 设置undo起点
  20.   (setq snap (getvar "osmode"))         ; 关闭捕捉
  21.   (setvar "osmode" 0)
  22.   (command "style" "tssd_dimension" "thz")
  23.   (if (= (tblsearch "layer" "txt") nil) ; 新建个文字层
  24.     (command "layer" "N" "txt" "C" 7 "txt" "")
  25.   )
  26.   (if (= (tblsearch "layer" "see") nil) ; 新建个细线成
  27.     (command "layer" "N" "see" "C" 3 "see" "")
  28.   )
  29.   (setq file (open "c:/图纸目录x.TXT" "r")) ; 读取临时txt的内容
  30.   (setq date (read-line file))
  31.   (setq date2 '())
  32.   (setq lst '())
  33.   (while date
  34.    (setq date2 (read (strcat "(" date ")")))
  35.    (setq lst (cons date2 lst))
  36.    (setq date (read-line file))
  37.   )
  38.   (close file)
  39.   ;(vl-file-delete "c:\\图纸目录x.TXT")
  40.   ;(setq lst (reverse lst))


  41.   (setq i 0)
  42.   (setq lst1 '()
  43.   lst2 '()
  44.   )
  45.   (while (< i (length lst))
  46.     (setq lst1 (list (vl-symbol-name (car (nth i lst))) (vl-symbol-name (cadr (nth i lst)))))
  47.     (setq lst2 (cons lst1 lst2))
  48.     (setq i (+ i 1))
  49.   )
  50.   (setq lst lst2)

  51.     (setq lst (vl-sort lst
  52.              (function (lambda (e1 e2)
  53.                          (< (cadr e1) (cadr e2))))))


  54.   (setq apnt (getpoint "\n选择目录放置点:"))
  55.   (setq  apnt_x (car apnt)
  56.   apnt_y (cadr apnt)
  57.   )
  58.     (setq pt1 (list (- apnt_x 5) (- apnt_y 5)))
  59.     (setq pt2 (list (+ (+ apnt_x (* (fix (/ (length lst) 28)) 110)) 100) (+ apnt_y 237)))
  60.    
  61.   (setq i 0)
  62.   (while (< i (length lst))
  63.     (if (= (rem i 28) 0)
  64.       (progn
  65.   (setq x0 (+ apnt_x (* (fix (/ i 28)) 110))
  66.         y0 apnt_y
  67.   )
  68.   (hzbg x0 y0)           ; 绘制图纸目录的格式
  69.   (setq j 0)
  70.       )
  71.     )
  72.     (setq a (nth i lst))         ; 下面程序写入内容
  73.     (setq pt1 (list (+ x0 500) (- (+ y0 22000) (* j 800))))
  74.     (command "text" "j" "mc" pt1 350 0 (itoa (+ i 1)))
  75.     (setq en (entlast))
  76.     (command ".change" en "" "p" "la" "txt" "")
  77.     (setq pt1 (list (+ x0 1200) (- (+ y0 22000) (* j 800))))
  78.     (command "text" "j" "ml" pt1 350 0 (car a))
  79.     (setq en (entlast))
  80.     (command ".change" en "" "p" "la" "txt" "")

  81.     (setq pt1 (list (+ x0 7750) (- (+ y0 22000) (* j 800))))
  82.     (command "text" "j" "mc" pt1 350 0 (cadr a))
  83.     (setq en (entlast))
  84.     (command ".change" en "" "p" "la" "txt" "")
  85.     (setq pt1 (list (+ x0 9000) (- (+ y0 22000) (* j 800))))
  86.     (command "text" "j" "mc" pt1 350 0 "详图")
  87.     (setq en (entlast))
  88.     (command ".change" en "" "p" "la" "txt" "")
  89.     (setq i (+ i 1))
  90.     (setq j (+ j 1))
  91.   )

  92.   (command ".UNDO" "E")           ; 设置undo终点
  93.   (setvar "filedia" 1)
  94.   (setvar "osmode" snap)

  95.   (princ)
  96. )
  97. (defun hzbg (x0 y0 / en i pt1 pt2 pt3)
  98.   (setq pt1 (list (+ x0 0) (+ y0 23200))
  99.   pt2 (list (+ x0 9500) y0)
  100.   )
  101.   (command ".rectang" pt1 pt2)
  102.   (setq en (entlast))
  103.   (command ".change" en "" "p" "la" "see" "")
  104.   (command "_pedit" en "w" 0.5 "")
  105.   (setq pt1 (list (+ x0 0) (+ y0 22400))
  106.   pt2 (list (+ x0 9500) (+ y0 22400))
  107.   )
  108.   (command ".line" pt1 pt2 "")
  109.   (setq en (entlast))
  110.   (command ".change" en "" "p" "la" "see" "")

  111.   (setq i 0)
  112.   (while (<= i 26)
  113.     (setq pt1 (list (+ x0 0) (- (+ y0 21600) (* i 800)))
  114.     pt2 (list (+ x0 9500) (- (+ y0 21600) (* i 800)))
  115.           pt3 (list (+ x0 0) (+ y0 20800))
  116.     )
  117.     (command ".line" pt1 pt2 "")
  118.     (setq en (entlast))
  119.     (command ".change" en "" "p" "la" "see" "c" "1" "")
  120.     (command ".copy" en "" pt1 pt3)
  121.     (setq i (+ i 1))
  122.   )

  123.   (setq pt1 (list (+ x0 1000) (+ y0 0))
  124.   pt2 (list (+ x0 1000) (+ y0 23200))
  125.   )
  126.   (command ".line" pt1 pt2 "")
  127.   (setq en (entlast))
  128.   (command ".change" en "" "p" "la" "see" "c" "1" "")

  129.   (setq pt1 (list (+ x0 7000) (+ y0 0))
  130.   pt2 (list (+ x0 7000) (+ y0 23200))
  131.   )
  132.   (command ".line" pt1 pt2 "")
  133.   (setq en (entlast))
  134.   (command ".change" en "" "p" "la" "see" "c" "1" "")

  135.   (setq pt1 (list (+ x0 8500) (+ y0 0))
  136.   pt2 (list (+ x0 8500) (+ y0 23200))
  137.   )
  138.   (command ".line" pt1 pt2 "")
  139.   (setq en (entlast))
  140.   (command ".change" en "" "p" "la" "see" "c" "1" "")
  141.   
  142.   (command "textstyle" "tssd_dimension")
  143.   (setq pt1 (list (+ x0 500) (+ y0 22800)))
  144.   (command "text" "j" "mc" pt1 350 0 "序 号")
  145.   (setq en (entlast))
  146.   (command ".change" en "" "p" "la" "txt" "")
  147.   (setq pt1 (list (+ x0 4000) (+ y0 22800)))
  148.   (command "text" "j" "mc" pt1 350 0 "图         名")
  149.   (setq en (entlast))
  150.   (command ".change" en "" "p" "la" "txt" "")
  151.   (setq pt1 (list (+ x0 7750) (+ y0 22800)))
  152.   (command "text" "j" "mc" pt1 350 0 "图   号")
  153.   (setq en (entlast))
  154.   (command ".change" en "" "p" "la" "txt" "")
  155.   (setq pt1 (list (+ x0 9000) (+ y0 22800)))
  156.   (command "text" "j" "mc" pt1 350 0 "图 幅")
  157.   (setq en (entlast))
  158.   (command ".change" en "" "p" "la" "txt" "")
  159.   (princ)
  160. )


本帖子中包含更多资源

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

x
发表于 2013-7-24 15:50:23 | 显示全部楼层
我一直用自己写的http://bbs.mjtd.com/thread-96636-1-1.html
来统计图纸,你可以参考一下。
 楼主| 发表于 2013-7-24 16:40:54 | 显示全部楼层
谢谢楼上同志,我是基础太差,想在这个程序中先找找问题,以便学习
发表于 2013-7-24 20:48:39 | 显示全部楼层

这是从网上下的,我认为这个写目录最简单,可惜我不会添加其他属性

本帖最后由 BUBUBA918 于 2013-7-24 20:51 编辑

  1. ;此程序为根据图形内图框,自动写图形的目录。
  2. ;
  3. (defun c:mul(/ sel m tf th tm selm ss sst ssm k p1 p2)  
  4.   ;选择图框
  5.   (setq  sel (ssget "x" (list (cons -4 "<or") (cons 2 "图框A0") (cons 2 "图框A1") (cons 2 "图框A2") (cons -4 "or>"))))
  6.   
  7.   (if (= sel nil)
  8.     (progn
  9.       (princ "\n图中无有效图框.")
  10.       (quit)
  11.     ) )
  12.   
  13.   (setq m (sslength sel))
  14.   (setq sst '() k 1)
  15.   (while (>= (setq m (1- m)) 0)
  16.     (progn
  17.       (setq selm (ssname sel m))
  18.       (setq ss (cdr (assoc 2 (entget selm))))

  19.       ;提取图幅信息
  20.       (setq tf (substr ss 5))
  21.       (repeat 2
  22.   (progn
  23.     (setq selm (entnext selm))
  24.     (setq ss (entget selm))
  25.     ;提取图号,图名信息。
  26.     (if (= (cdr (assoc 2 ss)) "图号") (setq th (cdr (assoc 1 ss))))
  27.     (if (= (cdr (assoc 2 ss)) "图名")
  28.       (progn
  29.         (setq tm (cdr (assoc 1 ss)))
  30.         (if (< k (strlen tm)) (setq k (strlen tm)))
  31.       )
  32.     )
  33.   )
  34.       )
  35.       (setq ssm (list th tm tf))
  36.       (setq sst (cons ssm sst))
  37.     )
  38.   )
  39. ;图名,图号,图幅信息提取完成,存放在串列sst中。下面对串列sst进行排序。
  40.   (vl-load-com)
  41.   (setq sst (vl-sort sst (function (lambda (e1 e2) (< (atoi (car e1)) (atoi (car e2)))))))
  42.   (setq svar (getvar "osmode"))
  43.   (setvar "osmode" 0)
  44.   
  45. ;写表头
  46.   (setq m (length sst))
  47.   (setq p1 (getpoint "输入目录表格的左上角角点"))
  48.   (setq p2 (polar p1 (* 1.5 pi) (+ 1450 (* m 800))))
  49.   (command "layer" "N" "TAB" "S" "TAB" "")
  50.   (command "_line" p1 (polar p1 0 11800) "")  
  51.   (command "_line" p2 p1 "")
  52.   (command "_copy" (ssget "L") "" "m" p1 (polar p1 0 800) (polar p1 0 3500) (polar p1 0 10000)  (polar p1 0 11800) "")
  53.       
  54.   (setq p2 (polar p1 (* 1.5 pi) 650))
  55.   (command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 400) "500" "0" "序")
  56.   (command "_text" "s" "TSSD_Rein" "J" "c" (polar (polar p2 (* 1.5 pi) 650) 0 400) "500" "0" "号")
  57.   (setq p2 (polar p1 (* 1.5 pi) 975))
  58.   (command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 2150) "500" "0" "图     号")
  59.   (command "_text" "s" "TSSD_Rein" "J" "bl" (polar p2 0 3900) "500" "0" "图   纸   内   容")
  60.   (command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 10900) "500" "0" "图   幅")
  61.   (setq p2 (polar p1 (* 1.5 pi) 1450))
  62.   (command "_line" p2 (polar p2 0 11800) "")
  63.       
  64. ;写目录的内容
  65.   (setq k 1)
  66.   (repeat m
  67.     (progn
  68.       (setq p2 (polar p2 (* 1.5 pi) 650))
  69.       (command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 400) "500" "0" k)
  70.       (command "_text" "s" "TSSD_Rein" "J" "c" (polar p2 0 2150) "500" "0" (strcat "结施-" (car (car sst))  "/" (itoa m)))
  71.       (command "_text" "s" "TSSD_Rein" "J" "BL" (polar p2 0 3900) "500" "0" (cadr (car sst)))
  72.       (command "_text" "s" "TSSD_Rein" "j" "c" (polar p2 0 10900) "500" "0" (caddr (car sst)))
  73.       (setq p2 (polar p2 (* 1.5 pi) 150))
  74.       (command "_line" p2 (polar p2 0 11800) "")
  75.       (setq k (1+ k))
  76.       (setq sst (cdr sst))
  77.     )
  78.   )
  79.   (setvar "osmode" svar)

  80.   (prin1)
  81. )

  82. (prompt "**mul**")
  83. (prin1)

  84. ;作者:QQ549476107
  85. ;欢迎共同讨论学习








本帖子中包含更多资源

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

x
 楼主| 发表于 2013-7-25 10:00:25 | 显示全部楼层
谢谢BUBUBA918,正在测试你上传的程序
 楼主| 发表于 2013-7-25 10:08:42 | 显示全部楼层
能否把你的配套图框上传一套,我对比下变量参数
发表于 2013-7-26 08:08:11 | 显示全部楼层
这是原版的目录和说明

本帖子中包含更多资源

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

x
发表于 2013-7-26 08:10:18 | 显示全部楼层
这是我做的图签,可是不会添加提取属性,请斑竹出来改下程序,或说明一下如何增加提取属性

本帖子中包含更多资源

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

x
 楼主| 发表于 2013-7-26 08:45:54 | 显示全部楼层
再次感谢BUBUBA918,参考BUBUBA918提供的程序,已将原程序一定程度上改善。
发表于 2015-1-6 16:36:08 | 显示全部楼层
学习一下!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-5-23 10:04 , Processed in 0.165370 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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