找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1928|回复: 8

[求助] 一个图纸目录生成程序 需要高手帮忙修改下!

[复制链接]

已领礼包: 127个

财富等级: 日进斗金

发表于 2013-11-6 11:50:00 | 显示全部楼层 |阅读模式

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

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

×
本帖最后由 spp_wall 于 2013-11-6 14:48 编辑

     一个图纸目录生成程序 需要高手帮忙修改下!  要求在下面的压缩文件里  


    希望高手出手完善下功能!谢谢!
有些问题和需要修改的东西在下面

1.为什么我自己定义的属性块程序无法处理,应该如何修改?
2:现在只能识别dwg的文件名,是否能增加识别xls文件的文件名
3:希望生成的xls能像下面的目录一样能分栏
4.是否能对属性块进行选择来匹配相关的图名  页码 备注



(defun c:tu1 ()
  ;03/12/31改
  (alert "这个程序用于路桥,图形是1:1,图框放大;\n03/12/31")
  (setvar "cmdecho" 0)
  (setq no 1)
  (if (SETQ TEMFILE (OPEN "D:/INFIEL" "r"))
    (progn (SETQ INF (READ-LINE TEMFILE))
    (CLOSE TEMFILE)
    )
    (setq inf "d:/")
  )
  (setq infile (getfiled "input file name" INF "*" 0))
  (command "sh" "del d:/infile")
  (SETQ TEMFILE (OPEN "D:/INFIEL" "w"))
  (princ infile temfile)
  (CLOSE TEMFILE)   ;(setq f1 (open infile "r"))
  (setq path1 (vl-filename-directory infile))
  (setq path2 (strcat path1 "\\"))
  (setq namelist (vl-directory-files path1 "*.dwg" 1))
  (setq xls_name (vl-directory-files path1 "*.xls" 1))
  (setq doc_name (vl-directory-files path1 "*.doc" 1))
     ;(print f1)
  (if (SETQ TEMdate (OPEN "D:/date" "r"))
    (progn (SETQ INF (READ-LINE TEMdate))
    (CLOSE TEMdate)
    )
    (setq inf "d:/")
  )
  (setq oufile (getfiled "input file name" inf "*" 1))
  (command "sh" "del d:/date")
  (SETQ TEMdate (OPEN "D:/date" "w"))
  (princ oufile TEMdate)
  (CLOSE TEMdate)

  ;;
  (setq ou_list (strcat oufile "li"))
  (setq f_list (open ou_list "w"))

  (setq li_no 0)
  (while (nth li_no namelist)
    (princ (+ li_no 1) f_list)
    (prin1 (nth li_no namelist) f_list)
    (princ "\n" f_list)
    (setq li_no (1+ li_no))
  )
  (close f_list)
  ;;

  ;;     ;(princ "序号 图形文件名 图号 零部件名 材料 图纸尺寸 " f)
     ;(princ "11gfdfg      jkfds" f)
  (setq pathlen1 (strlen infile))
  (setq pathlen pathlen1)
;;;;;;;;;;;;;;

  (while (/= "\\"
      (substr infile pathlen 1)
  )
    (setq pathlen (- pathlen 1))
  )
  ;;
     ;(setq len (- pathlen1 pathlen))
  (setq path (substr infile 1 pathlen))
  (setq file_len (length namelist))
  (setq file_num 0)
;;;begin per dwg file;
  (while (setq name1 (nth file_num namelist))
    (setq name (strcat path2 name1))
    (setq file_num (1+ file_num))
    (print name)
    (setq f (open oufile "a"))
    (if (findfile name)
      (progn
(princ "1111111111111111111111111111111111")
(command "erase" "all" "")
(command "purge" "all" "*" "n")
(command "purge" "all" "*" "n")
(command "zoom" "e")
(command "insert"
   (strcat (itoa (+ 500 no)) "=" name)
   '(0 0)
   1
   1
   0
)
(command "explode" "all")
(command "purge" "all" "*" "n")
(command "layer" "on" "*" "t" "*" "u" "*" "")
;(princ no f)
(princ "2222222222222222222222222222222222")
;(princ " " f)
(princ "no")
;(princ no)
;(princ name1 f)
;(a1 name1 f)


(princ "  ")
(princ name1)
(fram name1 f)
(princ "nnnnnnnnn")
(princ name1)
(setq xls_len (strlen name1))
(setq xls_dg (substr name1 1 (- xls_len 4)))
(setq xlsname (strcat xls_dg ".xls"))
(setq docname (strcat xls_dg ".doc"))
        (cond ((member xlsname xls_name) (princ " 有明细表" f)(princ "\n" f))
       ((member docname doc_name) (princ " 有明细表" f)(princ "\n" f))
       (t (princ "\n" f))
        )
      )
    )
    (close f)
  )
     ;(close f1)
  (alert "finish")
)
;;;;;
(defun nn ()
(setq no (1+ no))
(princ "in to")
(setq size_x (- (nth 0 (getvar "extmax"))
   (nth 0 (getvar "extmin"))
       )
)
(setq size_y (- (nth 1 (getvar "extmax"))
   (nth 1 (getvar "extmin"))
       )
)
(princ size_x)
(princ "\n")
(princ size_y)
(princ "\n")
;;;;;
(COND ((ssget "x" '((0 . "INSERT") (2 . "GB-A1")))
        (SETQ BLKNAME 1)
       )
       ((ssget "x" '((0 . "INSERT") (2 . "GB-A2")))
        (SETQ BLKNAME 2)
       )
       ((ssget "x" '((0 . "INSERT") (2 . "GB-A3")))
        (SETQ BLKNAME 3)
       )
       ((ssget "x" '((0 . "INSERT") (2 . "GB-A4")))
        (SETQ BLKNAME 4)
       )
       (T (SETQ BLKNAME 5))
)
;;;;;;;;;;;;;;;
(if sca
   (setq sca_n (sc sca))
)
(if (or (= 0 sca_n) (null sca_n))
   (setq sca_n 1)
   (setq size_x (* size_x sca_n))
)
;;;;;;;
(if  (< size_x 315)
   (progn (if (= BLKNAME 4) (setq size "A4") (setq size "A4-maybe-error")))

)
(if (and (< size_x 440)
   (> size_x 410)
     ;(< size_y 299)
     ;(> size_y 290)
     )
   (progn (if (= BLKNAME 3)  (setq size "A3") (setq size "A3-maybe-error")))
)
(if (and (< size_x 600)
   (> size_x 590)
    ;(< size_y 425)
     ;(> size_y 415)
     )
    (progn (if (= BLKNAME 2)  (setq size "A2") (setq size (strcat (itoa blkname) "A2-maybe-error"))))
  )
(if (and (< size_x 865)
   (> size_x 835)
    ;(< size_y 599)
     ;(> size_y 590)
     ) (progn (if (= BLKNAME 1)  (setq size "A1") (setq size "A1-maybe-error")))

)
(if (and (< size_x 20000)
   (> size_x 1180)
     ;(< size_y 599)
     ;(> size_y 590)
     )
   (setq size "A0")
)
(if (and (< size_x 400)
   (>= size_x 315)
     ;(< size_y 299)
     ;(> size_y 290)
     )
   (setq size "A4加长")
)
(if (and (< size_x 590)
   (>= size_x 440)
     ;(< size_y 299)
     ;(> size_y 290)
     )
   (setq size "A3加长")
)
(if (and (< size_x 835)
   (>= size_x 600)
     ;(< size_y 425)
     ;(> size_y 415)
     )
   (setq size "A2加长")
)
(if
   (and
     (< size_x 1180)
     (> size_x 865)
     ;(< size_y 599)
     ;(> size_y 590)
   )
    (setq size "A1加长")
)
(command "zoom" "e")
(print "size_x")
(print size_x)
(princ " " f)
(prin1 size f)
(princ " " f)
(princ "size")
(princ size)
   )

;;;;;;;;;;;;;;;;;
(defun FRAM (name f / e li l2 key)
  (setq jslq 0)
  (if (setq e (entnext))
    (progn
      (while e

(setq l1 (entget e))
(if (= (cdr (assoc 2 l1)) "JSLQ")(setq jslq 1))                              
(setq key 1)
(if (and (= (cdr (assoc 0 l1)) "INSERT")
   (= (cdr (assoc 66 l1)) 1)
     )
   (while
     (/= (cdr (assoc 0
       (setq l2 (entget (setq e (entnext e))))
       )
  )
  "SEQEND"
     )
;;;;;;;;;;;;;write out drawing_dwg_file name and drawing number(tu hao);
      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-NR{9.70}")
        (= key 1)
   )
        (progn
   (setq tuhao (cdr (assoc 1 l2)))
     ;(princ name f)  ;dwg file name   
     ;(princ  f) ;tu hao
   (princ (cdr (assoc 1 l2)))
   (princ name)
   (princ "\n")
   (setq key (1+ key)) ; (wfile 70 l2)
        )
      )    ;(wfile 50 l2)
;;;;;;;;;;write out part(s) name (tu ming)
      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-DES1{7.20}")
   )
        (progn
   (if (/= (cdr (assoc 1 l2)) "")
     (prin1 (setq pname (cdr (assoc 1 l2))));part name
     (princ (setq pname "未标明"))
   )
   (prin1 (cdr (assoc 1 l2)))
   (princ " ")
   (princ pname)
     ;block attrib value
   (princ "\n")
        )
      )
     ;;;sca

      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-SCA")
   )
        (progn
   (if (/= (cdr (assoc 1 l2)) "")
     (prin1 (setq sca (cdr (assoc 1 l2))) )
     (princ "未标明" )
   )
   (princ " " )
   (prin1 (cdr (assoc 1 l2)))
   (princ " ")
   (princ name)
     ;block attrib value
   (princ "\n")
        )
      )
;;;metieral cai liao
      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-MAT1{9.60}")
   )
        (progn
   (if (/= (cdr (assoc 1 l2)) "")
     (prin1 (setq cailiao (cdr (assoc 1 l2))))
     (princ (setq cailiao "未标明"))
   )
   (princ (cdr (assoc 1 l2)))
   (princ " ")
   (princ name)
    ;block attrib value
   (princ "\n")
        )
      )
   )    ;while
) ;if

(setq e (entnext e))
      )     ;while
    )
  )
  (nn)
  (if (= jslq 1)
    (progn
      (princ " " f)
      (prin1 tuhao f)
      (princ " " f)
      (princ pname f)
      (princ " " f)
      (prin1 "1" f)
      (princ " " f)
    )
    (prin1 (wu name) f)
  )
  (princ)
)
;;;;;;;;;;;;;;;;;
(defun wu (name / k no_name len1 qian)
  (setq len1 (strlen name))
  (setq k 1)
  (while (and (/= (setq no_name (substr name k 4)) ".dwg") (<= k len1))
    (setq k (1+ k))
  )
  (if (< k len1)
    (setq qian (substr name 1 (1- k)))
  )
)


;;;;;;;;;;;;;

(defun a1 (name f / e li l2 key)
  (if (setq e (entnext))
    (progn
      (while e
(setq l1 (entget e))
(setq key 1)
(if (and (= (cdr (assoc 0 l1)) "INSERT")
   (= (cdr (assoc 66 l1)) 1)
     )
   (while
     (/= (cdr (assoc 0
       (setq l2 (entget (setq e (entnext e))))
       )
  )
  "SEQEND"
     )
;;;;;;;;;;;;;write out drawing_dwg_file name and drawing number(tu hao);
      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-NR{9.70}")
        (= key 1)
   )
        (progn
     ;(princ name f)  ;dwg file name   
   (princ " " f)
   (princ (cdr (assoc 1 l2)) f) ;tu hao
   (princ (cdr (assoc 1 l2)))
   (princ " " f)
   (princ name)
   (princ "\n")
   (setq key (1+ key)) ; (wfile 70 l2)
        )
      )    ;(wfile 50 l2)
;;;;;;;;;;write out part(s) name (tu ming)
      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-DES1{7.20}")
   )
        (progn
   (if (/= (cdr (assoc 1 l2)) "")
     (prin1 (cdr (assoc 1 l2)) f)
     (princ "未标明" f)
   )
   (princ " " f)
   (prin1 (cdr (assoc 1 l2)))
   (princ " ")
   (princ name)
     ;block attrib value
   (princ "\n")
        )
      )
;;;;;scale
      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-SCA")
   )
        (progn
   (if (/= (cdr (assoc 1 l2)) "")
     (prin1 (setq sca (cdr (assoc 1 l2))) )
     (princ "未标明" )
   )
   (princ " " )
   (prin1 (cdr (assoc 1 l2)))
   (princ " ")
   (princ name)
     ;block attrib value
   (princ "\n")
        )
      )
;;;metieral cail iao
      (if (and (= (cdr (assoc 2 l1)) "JSLQ")
        (= (cdr (assoc 2 l2)) "GEN-TITLE-MAT1{9.60}")
   )
        (progn
   (if (/= (cdr (assoc 1 l2)) "")

     (prin1 (cdr (assoc 1 l2)) f)

     (princ "未标明" f)
   )
   (princ " " f)
   (princ (cdr (assoc 1 l2)))
   (princ " ")
   (princ name)
     ;block attrib value
   (princ "\n")
        )
      )
   )    ;while
)    ;if
(setq e (entnext e))
      )     ;while
    )
  )
  (princ)
)
;;;;;;;;;;;;
(defun sc (sca / sca_len k qian hou qian1 hou1 sca_n)
     ;(setq sca (getstring))
  (setq sca_len (strlen sca))
  (princ sca_len)
  (setq k 1)
  (while (and (/= (setq no_sca (substr sca k 1)) ":") (<= k sca_len))
    (setq k (1+ k))
  )
  (if (< k sca_len)
    (progn
      (setq qian (substr sca 1 (1- k)))
      (setq hou (substr sca (1+ k)))
      (setq qian1 (read qian))
      (setq hou1 (read hou))
      (setq hou1 (* hou1 1.0))
      (if (and (numberp qian1) (numberp hou1) (/= hou1 0))
(progn
   (setq sca_n (/ qian1 hou1))
   (princ sca_n)
)
      )
    )
  )
)

现在程序生成的目录

现在程序生成的目录

希望程序生成的目录

希望程序生成的目录

目录测试.zip

209.83 KB, 下载次数: 24, 下载积分: D豆 -1 , 活跃度 1

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 40个

财富等级: 招财进宝

发表于 2013-11-6 14:41:03 | 显示全部楼层
把你所有的要求都截图贴出来,不是谁有有时间下载附件研究的。

点评

以放上图片和修改的要求 有空看看  详情 回复 发表于 2013-11-6 14:50
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-6 14:48:02 来自手机 | 显示全部楼层
如果是属性块试试"数据导出"功能

点评

好像是听说可以提取属性块做 目录 请问在CAD哪里呢!  详情 回复 发表于 2013-11-6 14:49
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 127个

财富等级: 日进斗金

 楼主| 发表于 2013-11-6 14:49:27 | 显示全部楼层
st788796 发表于 2013-11-6 14:48
如果是属性块试试"数据导出"功能

好像是听说可以提取属性块做 目录  

请问在CAD哪里呢!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 127个

财富等级: 日进斗金

 楼主| 发表于 2013-11-6 14:50:53 | 显示全部楼层
newer 发表于 2013-11-6 14:41
把你所有的要求都截图贴出来,不是谁有有时间下载附件研究的。

以放上图片和修改的要求  有空看看

点评

这只是生成的带EXCEL能处理分隔的文本文件,后缀为xls,那个程序太罗嗦了,没几句话的应用  详情 回复 发表于 2013-11-6 15:17
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-6 15:17:28 来自手机 | 显示全部楼层
spp_wall 发表于 2013-11-6 14:50
以放上图片和修改的要求  有空看看

这只是生成的带EXCEL能处理分隔的文本文件,后缀为xls,那个程序太罗嗦了,没几句话的应用
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2476个

财富等级: 金玉满堂

发表于 2013-11-6 15:19:25 | 显示全部楼层
用TABLE属性块只会更简单!

点评

编辑现有的数据提取 这个东西怎么搞呢?  详情 回复 发表于 2013-11-6 16:04
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 127个

财富等级: 日进斗金

 楼主| 发表于 2013-11-6 16:04:02 | 显示全部楼层
本帖最后由 spp_wall 于 2013-11-6 16:18 编辑
q3_2006 发表于 2013-11-6 15:19
用TABLE属性块只会更简单!

生成的好像不太符合我的要求  而且这个好像只能对dwg有效

这个是命令提取的 TABLE提取的.png


我希望的 我希望的.png

点评

把不需要提取的数据去掉  详情 回复 发表于 2013-11-6 17:32
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1268个

财富等级: 财源广进

发表于 2013-11-6 17:32:47 | 显示全部楼层
spp_wall 发表于 2013-11-6 16:04
生成的好像不太符合我的要求  而且这个好像只能对dwg有效

这个是命令提取的

把不需要提取的数据去掉
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 00:59 , Processed in 0.576700 second(s), 53 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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