[试用]：图纸自动归档程序

szkevin · 发表于 2006-4-6 23:25:51

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

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

×

在这里感谢eachy编的图纸自动归档程序
这个程序运行时图纸必段同时满足以下三个条件
1.图框为块
2.图框在TK开头的图层上,
3,图号为定义为属性
本程序可以自动按图号wblock,并将wblock的文件命名为图号属性标签的值.

(defun xdl-Clearcset (/ cset)
(if (not (vl-catch-all-error-p
(setq cset
(vl-catch-all-apply
'vla-item
(list
(vla-get-selectionsets
(vla-get-activedocument (vlax-get-acad-object))
)
"CURRENT"
)
)
)
)
)
(vla-delete cset)
)
(princ)
)
(defun c:DWGWB
(/ ss ssl thisdrawing path i e obj box bp up atts name key0 n key s1)
(initget 128 "Select All")
(setq key0 (getkword "\n [自行选择(Select) /(All)]<All>: "))
(if (= key0 "Select")
(setq ss (ssget '((0 . "insert") (8 . "TK*") (66 . 1))))
(setq ss (ssget "x" '((0 . "insert") (8 . "TK*") (66 . 1))))
);_cond
(if ss
(progn
(setq ssl (sslength ss)
thisdrawing (vla-get-activedocument (vlax-get-acad-object))
path (getvar "dwgprefix")
i -1
)
(if (zerop
(length (vl-directory-files (strcat path "归档" "*.dwg")))
)
(vl-mkdir (strcat path "归档"))
)
(setq path (strcat path "归档\")
)
(repeat ssl
(setq e (ssname ss (setq i (1+ i)))
obj (vlax-ename->vla-object e)
)
(vla-getboundingbox obj 'bp 'up)
(setq bp (safearray-value bp)
up (safearray-value up)
)
(command ".zoom" "w" bp up)
(setq atts
(safearray-value (variant-value (vla-getattributes obj)))
)
(while atts
(if (= (vla-get-tagstring (car atts)) "图号")
(setq name (vla-get-textstring (car atts))
atts nil
)
)
(setq atts (cdr atts))
)
(if name
(progn
(xdl-clearcset)
(if (findfile (strcat path name ".dwg"))
(progn
(princ (strcat "\n" path name ".dwg 已存在!"))
(initget 128 "R S I")
(setq key
(getkword
"\n已有重名文件,请选择[R - 替换/S - 另存/I - 忽略]<R>:"
)
)
(cond
((= key "S")
(setq n 1)
(while
(findfile (strcat path name "同名" (itoa n) ".dwg")
)
(setq n (1+ n))
)
(setq name (strcat name "同名" (itoa n)))
(princ (strcat "\n文件另存为" path name ".dwg"))
)
((= key "I") (setq name nil))
(t)
)
)
)
(if name
(progn
(setq s1 (ssget "w" bp up))
(vla-wblock
thisdrawing
(strcat path name)
(vla-get-activeselectionset thisdrawing)
)
)
)
)
)
)
)
)
(command ".zoom" "e")
(princ "\n归档完毕")
)

(defun xdl-Clearcset (/ cset) 
  (if (not (vl-catch-all-error-p 
             (setq cset 
                    (vl-catch-all-apply 
                      'vla-item 
                      (list 
                        (vla-get-selectionsets 
                          (vla-get-activedocument (vlax-get-acad-object)) 
                        ) 
                        "CURRENT" 
                      ) 
                    ) 
             ) 
           ) 
      ) 
    (vla-delete cset) 
  ) 
  (princ) 
) 
(defun c:DWGWB 
       (/ ss ssl thisdrawing path i e obj box bp up atts name key0 n key s1) 
  (initget 128 "Select All") 
  (setq key0 (getkword "\n [自行选择(Select) /(All)]<All>: ")) 
  (if (= key0 "Select") 
    (setq ss (ssget '((0 . "insert") (8 . "TK*") (66 . 1)))) 
    (setq ss (ssget "x" '((0 . "insert") (8 . "TK*") (66 . 1)))) 
  );_cond 
  (if ss 
    (progn 
      (setq ssl                (sslength ss) 
            thisdrawing        (vla-get-activedocument (vlax-get-acad-object)) 
            path        (getvar "dwgprefix") 
            i                -1 
      ) 
      (if (zerop 
            (length (vl-directory-files (strcat path "归档" "*.dwg"))) 
          ) 
        (vl-mkdir (strcat path "归档")) 
      ) 
      (setq path (strcat path "归档\") 
      ) 
      (repeat ssl 
        (setq e          (ssname ss (setq i (1+ i))) 
              obj (vlax-ename->vla-object e) 
        ) 
        (vla-getboundingbox obj 'bp 'up) 
        (setq bp (safearray-value bp) 
              up (safearray-value up) 
        ) 
        (command ".zoom" "w" bp up) 
        (setq atts 
               (safearray-value (variant-value (vla-getattributes obj))) 
        ) 
        (while atts 
          (if (= (vla-get-tagstring (car atts)) "图号") 
            (setq name (vla-get-textstring (car atts)) 
                  atts nil 
            ) 
          ) 
          (setq atts (cdr atts)) 
        ) 
        (if name 
          (progn 
            (xdl-clearcset) 
            (if        (findfile (strcat path name ".dwg")) 
              (progn 
                (princ (strcat "\n" path name ".dwg 已存在!")) 
                (initget 128 "R S I") 
                (setq key 
                       (getkword 
                         "\n已有重名文件,请选择[R - 替换/S - 另存/I - 忽略]<R>:" 
                       ) 
                ) 
                (cond 
                  ((= key "S") 
                   (setq n 1) 
                   (while 
                     (findfile (strcat path name "同名" (itoa n) ".dwg") 
                     ) 
                      (setq n (1+ n)) 
                   ) 
                   (setq name (strcat name "同名" (itoa n))) 
                   (princ  (strcat "\n文件另存为" path name ".dwg")) 
                  ) 
                  ((= key "I") (setq name nil)) 
                  (t) 
                ) 
              ) 
            ) 
            (if        name 
              (progn 
                (setq s1 (ssget "w" bp up)) 
                (vla-wblock 
                  thisdrawing 
                  (strcat path name) 
                  (vla-get-activeselectionset thisdrawing) 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (command ".zoom" "e") 
  (princ "\n归档完毕") 
)

雨箭风刀 · 发表于 2006-4-7 02:00:04

提两条：
1.vla-getboundingbox 返回wcs点。如果图框有角度就不行了（有时候会碰到）
2.应对打开的图层解锁，否则以为选集已经包含了（尤其是全选的时候比较容易忽视），其实没有。

eachy · 发表于 2006-4-7 10:55:26

(defun xdl-Clearcset (/ cset)
(if (not (vl-catch-all-error-p
(setq cset
(vl-catch-all-apply
'vla-item
(list
(vla-get-selectionsets
(vla-get-activedocument (vlax-get-acad-object))
)
"CURRENT"
)
)
)
)
)
(vla-delete cset)
)
(princ)
)
(defun c:DWGWB (/ ss ssl thisdrawing path i e
obj box bp up atts name key0 n
key s1 na tag
)
(princ "\n选择归档范围[All - 全选]....")
(if (and (setq ss (ssget '((0 . "insert") (8 . "TK*") (66 . 1))))
(setq na (nentsel "\n点取属性图名: "))
(= (cdr (assoc 0 (setq al (entget na)))) "ATTRIB")
(setq tag (cdr (assoc 2 al)))
)
(progn
(setq ssl (sslength ss)
thisdrawing (vla-get-activedocument (vlax-get-acad-object))
path (getvar "dwgprefix")
i -1
)
(vla-startundomark thisdrawing)
(vlax-for lay (vla-get-layers thisdrawing)
(vla-put-lock lay :vlax-false)
)
(if (zerop
(length (vl-directory-files (strcat path "归档" "*.dwg")))
)
(vl-mkdir (strcat path "归档"))
)
(setq path (strcat path "归档\"))
(command ".zoom" "o" ss "") ;_仅适用 2004+
(repeat ssl
(setq e (ssname ss (setq i (1+ i)))
obj (vlax-ename->vla-object e)
)
(vla-getboundingbox obj 'bp 'up)
(setq bp (safearray-value bp)
up (safearray-value up)
)
(command ".zoom" "w" bp up)
(setq atts
(safearray-value (variant-value (vla-getattributes obj)))
)
(while atts
(if (= (vla-get-tagstring (car atts)) tag)
(setq name (vla-get-textstring (car atts))
atts nil
)
)
(setq atts (cdr atts))
)
(if name
(progn
(xdl-clearcset)
(if (findfile (strcat path name ".dwg"))
(progn
(princ (strcat "\n" path name ".dwg 已存在!"))
(initget 128 "S I")
(setq key
(getkword
"\n已有重名文件,请选择[S - 另存/I - 忽略]<回车替换>:"
)
)
(cond
((= key "S")
(setq n 1)
(while
(findfile (strcat path name "同名" (itoa n) ".dwg")
)
(setq n (1+ n))
)
(setq name (strcat name "同名" (itoa n)))
(princ (strcat "\n文件另存为" path name ".dwg"))
)
((= key "I") (setq name nil))
(t)
)
)
)
(if name
(progn
(setq s1 (ssget "w" bp up))
(vla-wblock
thisdrawing
(strcat path name)
(vla-get-activeselectionset thisdrawing)
)
)
)
)
)
)
(vla-endundomark thisdrawing)
)
)
(command ".zoom" "p")
(princ "\n归档完毕")
)

(defun xdl-Clearcset (/ cset) 
  (if (not (vl-catch-all-error-p 
             (setq cset 
                    (vl-catch-all-apply 
                      'vla-item 
                      (list 
                        (vla-get-selectionsets 
                          (vla-get-activedocument (vlax-get-acad-object)) 
                        ) 
                        "CURRENT" 
                      ) 
                    ) 
             ) 
           ) 
      ) 
    (vla-delete cset) 
  ) 
  (princ) 
) 
(defun c:DWGWB (/      ss     ssl    thisdrawing   path          i         e 
                obj    box    bp     up            atts   name          key0         n 
                key    s1     na     tag 
               ) 
  (princ "\n选择归档范围[All - 全选]....") 
  (if (and (setq ss (ssget '((0 . "insert") (8 . "TK*") (66 . 1)))) 
           (setq na (nentsel "\n点取属性图名: ")) 
           (= (cdr (assoc 0 (setq al (entget na)))) "ATTRIB") 
           (setq tag (cdr (assoc 2 al))) 
      ) 
    (progn 
      (setq ssl                (sslength ss) 
            thisdrawing        (vla-get-activedocument (vlax-get-acad-object)) 
            path        (getvar "dwgprefix") 
            i                -1 
      ) 
      (vla-startundomark thisdrawing) 
      (vlax-for        lay (vla-get-layers thisdrawing) 
        (vla-put-lock lay :vlax-false) 
      ) 
      (if (zerop 
            (length (vl-directory-files (strcat path "归档" "*.dwg"))) 
          ) 
        (vl-mkdir (strcat path "归档")) 
      ) 
      (setq path (strcat path "归档\")) 
      (command ".zoom" "o" ss "") ;_仅适用 2004+ 
      (repeat ssl 
        (setq e          (ssname ss (setq i (1+ i))) 
              obj (vlax-ename->vla-object e) 
        ) 
        (vla-getboundingbox obj 'bp 'up) 
        (setq bp (safearray-value bp) 
              up (safearray-value up) 
        ) 
        (command ".zoom" "w" bp up) 
        (setq atts 
               (safearray-value (variant-value (vla-getattributes obj))) 
        ) 
        (while atts 
          (if (= (vla-get-tagstring (car atts)) tag) 
            (setq name (vla-get-textstring (car atts)) 
                  atts nil 
            ) 
          ) 
          (setq atts (cdr atts)) 
        ) 
        (if name 
          (progn 
            (xdl-clearcset) 
            (if        (findfile (strcat path name ".dwg")) 
              (progn 
                (princ (strcat "\n" path name ".dwg 已存在!")) 
                (initget 128 "S I") 
                (setq key 
                       (getkword 
                         "\n已有重名文件,请选择[S - 另存/I - 忽略]<回车替换>:" 
                       ) 
                ) 
                (cond 
                  ((= key "S") 
                   (setq n 1) 
                   (while 
                     (findfile (strcat path name "同名" (itoa n) ".dwg") 
                     ) 
                      (setq n (1+ n)) 
                   ) 
                   (setq name (strcat name "同名" (itoa n))) 
                   (princ (strcat "\n文件另存为" path name ".dwg")) 
                  ) 
                  ((= key "I") (setq name nil)) 
                  (t) 
                ) 
              ) 
            ) 
            (if        name 
              (progn 
                (setq s1 (ssget "w" bp up)) 
                (vla-wblock 
                  thisdrawing 
                  (strcat path name) 
                  (vla-get-activeselectionset thisdrawing) 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
      (vla-endundomark thisdrawing) 
    ) 
  ) 
  (command ".zoom" "p") 
  (princ "\n归档完毕") 
)

szkevin · 发表于 2006-4-7 14:32:35

最初由雨箭风刀发布
[B]提两条：
1.vla-getboundingbox 返回wcs点。如果图框有角度就不行了（有时候会碰到）
2.应对打开的图层解锁，否则以为选集已经包含了（尤其是全选的时候比较容易忽视），其实没有。 [/B]

有道理!图纸归档是不允许出错的,所以还要应加以改进.
1,有没有获得用户坐标系的函数或将世界坐标系的坐标转换为用户坐标系的函数呢?如果有,将取的坐标系转换该图框所在的坐标系坐标,这个选中的物体就不会错.
2,对于图层解销,eachy已做了改进,已不是问题了.

aliu22 · 发表于 2006-4-8 12:20:37

有一个问题，你用的是增强属性编辑器做图框，那么如果我用的是块做图框呢（block），那怎么样实现呢(当然图号不会做成块的) , 而且归档的名称如何获取呢，

szkevin · 发表于 2006-4-8 12:29:57

最初由 aliu22 发布
[B]有一个问题，你用的是增强属性编辑器做图框，那么如果我用的是块做图框呢（block），那怎么样实现呢(当然图号不会做成块的) , 而且归档的名称如何获取呢， [/B]

这个没有办法,只有用属性做成的图框,程序才能准确无误而且方便的进行判定.用属性做成的图框好处是不明自诩的,还准备开发一个套件,可以打量对选定的文件进行图纸日期和版次,甚至建设单位和工程名称的修改.

aliu22 · 发表于 2006-4-9 16:14:53

请问如何做成强属性编辑器,我没有用过个功能，谢谢

szkevin · 发表于 2006-4-9 23:03:41

最初由 aliu22 发布
[B]请问如何做成强属性编辑器,我没有用过个功能，谢谢 [/B]

属性定义,在做块的时候用attdef定义属性.

hero_wch · 发表于 2006-4-10 21:41:03

图框和图签必须是一个属性块才行吗？如果是2个不同的块呢？

madeinchina · 发表于 2006-4-19 23:03:22

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

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

×

在布局里面可用吗

ss1025 · 发表于 2006-4-22 13:20:12

偶为了用秋枫斑竹的BATCHPLOT，图框是外部引用的，另外加了个PUBTITLE层的边框。请教长老，为了能用长老的归档程序，偶应该怎么办呢？
是不是要把图框做成快插入，再把图号做成属性块啊？

szkevin · 发表于 2006-4-22 22:17:35

1.把图框做成块,再把图号做成属性块,秋枫的batchplt也可以用.
2.在布局里不能用,因为布局里没法选中模型空间的图形.

tc405003 · 发表于 2006-4-23 07:54:18

请问程序能用吗，我这里好像不能用-

marker21 · 发表于 2009-8-11 16:36:25

可以用吗？
测试没有？

cy956 · 发表于 2009-8-15 14:33:18

任何的管理都有制度成本，制度的约定，在不同的工作内容不同的单位规模等等情况下，有不同的要求。

分单张dwg归档应该是一个误区，虽然那些归档软件都是这样约定的。谁能告诉我这样做的原因？
如果说约定图名，约定归档内容等等，那是应该的，但剥成一张张的dwg，有何必要？
1.大多数的公司，资料室人员，是搞不清楚图纸内容的，剥成单张不见得他们就能看得出来；
2.网上打图管理，签批基本上也仅仅是手续，因为管理成本，你不可能叫所有的项目负责人去一张张对图——实际上基本是下面提出打印报告单，项总稍微核对就签出了；如果是担心外活内打，加强出入口的管理也是一个办法。现在的设计单位，很多已经个体化或者项目化，他们爱打几遍，似乎不用总院操心。
3.存档调阅也不见得方便，很少说一套图纸的调阅，只给大样，或者只给平面——就算如果真要这样，也花不了多少时间。除非是有密级要求的图纸，可以理解，民用院似乎都没必要。
4.再说修改，大多数的设计院，都是对修改图另外存档，不需要替换，所以和修改似乎没有多大关系。
5.既然是dwg归档，除了归档要求本身，还有一个目的是为了图纸的延续性，（有的公司直接用plt归档，还有的设计院干脆提出大型扫描仪扫描归档，图统一了，但不能延续使用了。）从调阅方便来说，分图可能有点好处，但成本不低。现在的机器速度很快了，除了大规划图等似乎痛苦些，图稍微大点，一般问题不太大。从这一点来说，我怀疑分图的思路是486时代的思想遗留。
6.设计人员一张张报图输入，再乘以几次存档次数，花的时间很多。难道管理的目是为了花掉一线的时间？还是想降低资料室人员的工作压力？（他们的压力是日常的图纸出入管理工作，不是在归档这一道程序，不管分图合图给他，他也是签收一次）。

其实太多的设计单位，连图纸的统一措施都贯彻不下去，图名线形字体混乱，制图水平不高，图纸里面垃圾很多（我见过一张电图，8m左右，打开一看就一个表格，wblock一下，只剩下百来k）。这些问题更多、影响更大。加强管理，是否应该更实实质一些。

总的一句话，486时代的习惯+国营一统的管理思路+密级控制的要求，似乎是分图归档的最好解释。

弟兄们有何高见欢迎指教。

账号		自动登录	找回密码
密码			立即注册

[试用]：图纸自动归档程序

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

相关帖子

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

相关帖子