社区 › AutoCAD基础应用 › [推荐]去教育版印记工具（珍藏很久）附件已添加（2010.12.2）

dadahuzi 发表于 2011-4-21 08:51:30

谢谢楼主
希望可以

爱情 发表于 2011-4-22 06:41:45

找不到字体是怎么回事。

renande 发表于 2011-4-22 10:32:06

最好不用有标记的CAD文件或有标记的直接用DXF格式文件。。。

xieyanjiang 发表于 2011-4-22 16:03:22

好东西 我以前遇到过此类问题

zag0666 发表于 2011-4-27 10:17:48

这个不管用么？

defun c:Test (/      th-getfolder    th-str-repl
         txt-str-reverse th-CloseAllNotSave
         dwglst      dxflst      fulldwglst
         fulldxflst      path      fullbase
      )
   (defun th-getfolder (msg / winshell shfolder path catchit)
   (setq winshell (vlax-create-object "Shell.Application"))
   (setq
       shfolder (vlax-invoke-method winshell 'browseforfolder 0 msg 1)
   )
   (vl-catch-all-apply
       '(lambda ()
   (setq shfolder (vlax-get-property shfolder 'self))
   (setq path (vlax-get-property shfolder 'path))
      )
   )
   path
   )
   (defun th-str-repl (curchar newchar str)
   (while (vl-string-search curchar str)
       (setq str (vl-string-subst newchar curchar str))
   )
   str
   )
   (defun txt-str-reverse (string / string0 cur tmp_str num)
   (setq cur   ""
    string0 string
   )
   (while (/= (strlen string0) (strlen cur))
       (progn
(setq tmp_str (substr string (strlen string)))
(if (> (ascii tmp_str) 159)
    (progn
      (setq tmp_str (substr string (- (strlen string) 1)))
      (setq num 2)
    )
    (setq num 1)
)
(setq cur (strcat cur tmp_str))
(setq string (substr string 1 (- (strlen string) num)))
       )
   )
   cur
   )
   (defun th-CloseAllNotSave (); 不保存关闭
   (vlax-for item (vla-get-documents (vlax-get-acad-object))
       (vl-catch-all-apply
(function (lambda ()
       (vla-close item :vlax-false)
   )
)
       )
   )
   )
   (if (setq path (th-getfolder "请选择资料夹: "))
   (progn
       (foreach dwg (setq fulldwglst
      (mapcar
      (function (lambda (file)
      (strcat path "\\" file)
         )
      )
      (setq dwglst
      (vl-directory-files
          path
          "*.dwg"
          1
      )
      )
      )
      )
(if (vl-catch-all-error-p
      (vl-catch-all-apply
   (function
   (lambda
       ()
      (vla-open
          (vla-get-documents
   (vlax-get-acad-object)
          )
          dwg
          :vlax-false
      )
   )
   )
      )
      )
    (princ (strcat "\n** " dwg " 打开失败 **"))
)
       )
       (setq dxflst (mapcar
      (function (lambda (x)
      (th-str-repl ".dwg" ".dxf" x)
         )
      )
      dwglst
      )
       )
       (setq fulldxflst
       (mapcar
         (function (lambda (x)
       (th-str-repl ".dwg" ".dxf" x)
   )
         )
         fulldwglst
       )
       )
       (setq fullbase (mapcar
          (function (lambda (x)
      (txt-str-reverse
          (substr
            (txt-str-reverse x)
            5
          )
      )
      )
          )
          fulldwglst
      )
       )
       (mapcar
(function (lambda (x y)
       (vl-catch-all-apply
         (function (lambda ()
       (vla-SaveAs
         (vla-item
         (vla-get-documents
      (vlax-get-acad-object)
         )
         x
         )
         y
         ac2004_dxf
       )
   )
         )
       )
   )
)
dwglst
fullbase
       )
       (th-CloseAllNotSave)
       (foreach dxf fulldxflst
(if (vl-catch-all-error-p
      (vl-catch-all-apply
   (function
   (lambda
       ()
      (vla-open
          (vla-get-documents
   (vlax-get-acad-object)
          )
          dxf
          :vlax-false
      )
   )
   )
      )
      )
    (princ (strcat "\n** " dxf " 打开失败 **"))
)
       )
       (mapcar
(function (lambda (x y)
       (vl-catch-all-apply
         (function (lambda ()
       (vla-SaveAs
         (vla-item
         (vla-get-documents
      (vlax-get-acad-object)
         )
         x
         )
         y
         ac2004_dwg
       )
   )
         )
       )
   )
)
dxflst
fullbase
       )
       (th-CloseAllNotSave)
       (foreach each fulldxflst
(vl-file-delete each)
       )
   )
   (princ "\n*取消*")
   )
   (princ)
)

jxphklibin 发表于 2011-5-13 09:50:47

多谢，楼主辛苦了

云消雾散 发表于 2011-5-13 12:48:40

不错啊，这下好了。谢谢楼主分享。

uc66188493 发表于 2011-5-13 14:25:24

正需要的啊

hhak003 发表于 2011-5-22 00:02:23

这个必须要强力支持一下！！这个印记烦死人了！！谢谢楼主

zhengchuan 发表于 2011-6-10 00:17:44

谢谢楼主分享

查看完整版本: [推荐]去教育版印记工具（珍藏很久）附件已添加（2010.12.2）