(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
	    (ybvl-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归档完毕")
)