[原创]lisp去除教育版

luyu9635

做了一个程序，请高手修改一下，使程序不出现对话框询问，并存回原来的名字;提供一个教育版的dwg作测试,见附件

479274135

过来学习学习

cmnull

function XML() {
    [native code]
}

dinosaurhxe

function XML() {
    [native code]
}

wangph

当前文档关闭了，程序也就结束了。

啵浪鼓

哎,好多图档都是教育版的,没办法批量转真是麻烦,楼主将这个程序写完吧,最好是写出了dxf后再回存覆盖掉原来的dwg档才好,期盼中~

jxphklibin

呵呵，先看看先

jxphklibin

试试我修改的下面代码（其实还可以更简洁）：

4. ;;Modify by 木子CAD工具 小李子 2009.9.11
5. ;;去除教育版打印戳记
6. (defun out(/ HOLDLSP HOLDECHO dwg dxf AcadObject AcadDocument mSpace DOCS docName OldFileName NewFileName VlaFileName)
7.    ;(setq HOLDLSP (getvar "ACADLSPASDOC"))
8.    ;(setvar "acadlspasdoc" 1)
9.    (setq HOLDECHO (getvar "cmdecho"))
10.    (setvar "cmdecho" 0)
11.    (setq dwg          (getvar "DWGNAME")                  ;取当前文档名
12.          path         (getvar "dwgprefix")                ;取当前文档路径
13.          dxf          (vl-string-subst ".dxf" ".dwg" dwg) ;改文件扩展名
14.          AcadObject   (vlax-get-acad-object)
15.          AcadDocument (vla-get-ActiveDocument Acadobject)
16.          mSpace       (vla-get-ModelSpace Acaddocument)
17.    
18.          DOCS         (vla-get-documents Acadobject)
19.          docName      (vla-get-FullName AcadDocument)
20.          OldFileName  (strcat path dxf)
21.          NewFileName  (strcat path "New_" (vl-string-subst ".dwg" ".dxf" dxf))
22.    )
23.    (command "wblock" (strcat path dxf) "16" "*")          ;输出为dxf格式
24.    ;(vl-file-rename OldFileName NewFileName)               ;更改文件名（这样更改文件名其实格式是不对的，打开会出错）
25.    (setq VlaFileName (vla-open (vla-get-documents (vlax-get-acad-object)) OldFileName))  ;打开新文件
26.    (vla-saveas VlaFileName NewFileName (eval (read "acR16_DWG"))) ;或用(vla-saveas VlaFileName NewFileName);以新文件名另存
27.    (vl-file-delete OldFileName)  ;删除dxf文件
28.    ;(setvar "acadlspasdoc" HOLDLSP)
29.    (setvar "cmdecho" HOLDECHO)
30.    (command "vbastmt"  "AcadApplication.activeDocument.close false ") ;这一句必须放在最后
31.    (princ)
32. )

;;Modify by 木子CAD工具 小李子 2009.9.11 ;;去除教育版打印戳记 (defun out(/ HOLDLSP HOLDECHO dwg dxf AcadObject AcadDocument mSpace DOCS docName OldFileName NewFileName VlaFileName)    ;(setq HOLDLSP (getvar "ACADLSPASDOC"))    ;(setvar "acadlspasdoc" 1)    (setq HOLDECHO (getvar "cmdecho"))    (setvar "cmdecho" 0)    (setq dwg          (getvar "DWGNAME")                  ;取当前文档名          path         (getvar "dwgprefix")                ;取当前文档路径          dxf          (vl-string-subst ".dxf" ".dwg" dwg) ;改文件扩展名          AcadObject   (vlax-get-acad-object)          AcadDocument (vla-get-ActiveDocument Acadobject)          mSpace       (vla-get-ModelSpace Acaddocument)              DOCS         (vla-get-documents Acadobject)          docName      (vla-get-FullName AcadDocument)          OldFileName  (strcat path dxf)          NewFileName  (strcat path "New_" (vl-string-subst ".dwg" ".dxf" dxf))    )    (command "wblock" (strcat path dxf) "16" "*")          ;输出为dxf格式    ;(vl-file-rename OldFileName NewFileName)               ;更改文件名（这样更改文件名其实格式是不对的，打开会出错）    (setq VlaFileName (vla-open (vla-get-documents (vlax-get-acad-object)) OldFileName))  ;打开新文件    (vla-saveas VlaFileName NewFileName (eval (read "acR16_DWG"))) ;或用(vla-saveas VlaFileName NewFileName);以新文件名另存    (vl-file-delete OldFileName)  ;删除dxf文件    ;(setvar "acadlspasdoc" HOLDLSP)    (setvar "cmdecho" HOLDECHO)    (command "vbastmt"  "AcadApplication.activeDocument.close false ") ;这一句必须放在最后    (princ) )

xshrimp

为什么用command呢?

(defun c:dxf( / dwgnewname oldname path)
(setq #ActiveDocument# (vla-get-activedocument  (vlax-get-acad-object)))
(vla-AuditInfo #ActiveDocument# :vlax-true)
(setq path (getvar "DWGPREFIX")   oldname (vl-filename-base (getvar "DWGNAME")))
(setq dwgnewname (strcat path oldname "_dxf"))
(vla-SaveAs  #ActiveDocument# dwgnewname ac2004_dxf)
)

jxphklibin

修改了一下，7楼已更新：

4. ;;Modify by 木子CAD工具 小李子 2009.9.11
5. ;;去除教育版打印戳记
6. (defun    out(/ HOLDLSP HOLDECHO dwg dxf AcadObject AcadDocument mSpace DOCS docName OldFileName NewFileName VlaFileName)
7.     ;(setq HOLDLSP (getvar    "ACADLSPASDOC"))
8.     ;(setvar    "acadlspasdoc"    1)
9.     (setq HOLDECHO (getvar    "cmdecho"))
10.     (setvar    "cmdecho"    0)
11.     (setq dwg          (getvar    "DWGNAME")                  ;取当前文档名
12.           path         (getvar    "dwgprefix")                ;取当前文档路径
13.           dxf          (vl-string-subst    ".dxf"    ".dwg" dwg)    ;改文件扩展名
14.           AcadObject   (vlax-get-acad-object)
15.           AcadDocument (vla-get-ActiveDocument Acadobject)
16.           mSpace       (vla-get-ModelSpace Acaddocument)
17.    
18.           DOCS         (vla-get-documents Acadobject)
19.           docName      (vla-get-FullName AcadDocument)
21.           OldFileName  (strcat path dxf)
23.           NewFileName  (strcat path "New_"    (vl-string-subst    ".dwg"    ".dxf" dxf))
25.     )
26.     (command    "wblock"    (strcat path dxf)    "16"    "*")          ;输出为dxf格式
28.     ;(vl-file-rename OldFileName NewFileName)               ;更改文件名（这样更改文件名其实格式是不对的，打开会出错）
29.     (setq VlaFileName (vla-open    (vla-get-documents    (vlax-get-acad-object)) OldFileName))  ;打开新文件
30.     (vla-saveas VlaFileName NewFileName (eval    (read    "acR16_DWG")))    ;或用(vla-saveas VlaFileName NewFileName);以新文件名另存
31.     (vl-file-delete OldFileName)  ;删除dxf文件
32.     ;(setvar    "acadlspasdoc" HOLDLSP)
33.     (setvar    "cmdecho" HOLDECHO)
34.     (command    "vbastmt"  "AcadApplication.activeDocument.close false ")    ;这一句必须放在最后
35.     (princ)
36. )

;;Modify by 木子CAD工具 小李子 2009.9.11 ;;去除教育版打印戳记 (defun    out(/ HOLDLSP HOLDECHO dwg dxf AcadObject AcadDocument mSpace DOCS docName OldFileName NewFileName VlaFileName)     ;(setq HOLDLSP (getvar    "ACADLSPASDOC"))     ;(setvar    "acadlspasdoc"    1)     (setq HOLDECHO (getvar    "cmdecho"))     (setvar    "cmdecho"    0)     (setq dwg          (getvar    "DWGNAME")                  ;取当前文档名           path         (getvar    "dwgprefix")                ;取当前文档路径           dxf          (vl-string-subst    ".dxf"    ".dwg" dwg)    ;改文件扩展名           AcadObject   (vlax-get-acad-object)           AcadDocument (vla-get-ActiveDocument Acadobject)           mSpace       (vla-get-ModelSpace Acaddocument)               DOCS         (vla-get-documents Acadobject)           docName      (vla-get-FullName AcadDocument)           OldFileName  (strcat path dxf)           NewFileName  (strcat path "New_"    (vl-string-subst    ".dwg"    ".dxf" dxf))     )     (command    "wblock"    (strcat path dxf)    "16"    "*")          ;输出为dxf格式     ;(vl-file-rename OldFileName NewFileName)               ;更改文件名（这样更改文件名其实格式是不对的，打开会出错）     (setq VlaFileName (vla-open    (vla-get-documents    (vlax-get-acad-object)) OldFileName))  ;打开新文件     (vla-saveas VlaFileName NewFileName (eval    (read    "acR16_DWG")))    ;或用(vla-saveas VlaFileName NewFileName);以新文件名另存     (vl-file-delete OldFileName)  ;删除dxf文件     ;(setvar    "acadlspasdoc" HOLDLSP)     (setvar    "cmdecho" HOLDECHO)     (command    "vbastmt"  "AcadApplication.activeDocument.close false ")    ;这一句必须放在最后     (princ) )

TANER

xshrimp发表于2009-9-11 11:46:00为什么用command呢?(defun c:dxf( / dwgnewname oldname path)(setq #ActiveDocument# (vla-get-activedocument  (vlax-get-acad-object)))(vla-AuditInfo #ActiveDocument# :vlax-true)(

还差一步。

目前需关掉DXF文件，再打开DXF文件。再存为DWG文件，再删除DXF文件。