- UID
- 674970
- 积分
- 469
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2013-4-8
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
本帖最后由 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
|