[LISP]如何在LISP中打开一个.dwg文件并另存之

chen4

我对于现在前面有VL的函数还是不通窍，平时依样画瓢，尚且不行，最近我的电脑CAD2000中文帮助(我用的是英文版，中文帮助是拷贝的)，不知何故，在用到Vlisp帮助时，说是acad_dev.cnt文件打不开，无法使用，所以现在更找不到南北了。


不好意思，还得有劳辉兄和各位高手帮助山人一把。

meflying

(defun c:test( / fjm0 fjm1 newdoc )
(setq fjm0 "d:/CAD与数据开发/00BLOCK/电信井.dwg")
(setq newdoc (vla-open (vla-get-documents (vlax-get-acad-object)) fjm0));打开并获得新文档

;**********以下部分是对新文档进行操作，必须使用ActiveX方法**********************
(vla-addCircle (vla-get-ModelSpace newdoc) (vlax-3d-point '(3.0 3.0 0.0)) 200.0)
;**********操作部分结束，这里的例子是在打开的图中画了一个圆*********************

(setq fjm1 "d:/CAD与数据开发/00BLOCK/电信井33.dwg")
(vla-saveas newdoc fjm1 acr15_DWG);另存打开的文档
;或将acr15_dwg改为ac2004_dwg存为2004格式，要在2004及以上版本才可以
(vla-close newdoc);关闭另存的文档
(princ)
)

chen4

上 述程序的功能是达到了，但 ;**********以下部分是对新文档进行操作，必须使用ActiveX方法**********************
(vla-addCircle (vla-get-ModelSpace newdoc) (vlax-3d-point '(3.0 3.0 0.0)) 200.0)
;**********操作部分结束，这里的例子是在打开的图中画了一个圆********************* 有些autolisp和cad本身的命令要全转换为必须使用ActiveX方法有一定的难度，有许多我还找不到对应的方法，不知能否继续改进，中间操作部分使用autolisp语言即可。 谢谢辉兄，谢谢各位!

meflying

学习vla，我已经说过两次了，使用autolisp的方法是不行的。。。


基本上所有事情都可以使用ActiveX方法来解决

ZZXXQQ

如下程序可以实现楼主的目的。 程序在打开的新图形中运行。在ACAD R14上调试通过。 (DEFUN C:SAVETO ()
(SETVAR "CMDECHO" 0)
(COMMAND "UNDO" "C" "N")
(SETQ NMM (GETFILED "Select First File Name" "" "dwg" 8))
(SETQ NMM1 (GETFILED "Select Second File Name" "" "dwg" 9))
(IF (> (STRLEN NMM) 0) (PROGN
(COMMAND "_INSERT" (STRCAT "*" NMM) "0,0" "" "")
(COMMAND "ZOOM" "E" "REGEN")
(SETQ P1 (GETVAR "EXTMIN") P2 (GETVAR "EXTMAX"))
;...... Add your process.
;......
(COMMAND "_WBLOCK" NMM1 "" "0,0" "C" P1 P2 "")
))
(COMMAND "UNDO" "A")
(SETVAR "CMDECHO" 1)
(PRINC)
)

chen4

Command: saveto
Unknown command "0,0". Press F1 for help.
Unknown command "C". Press F1 for help.
Unknown command "SAVETO". Press F1 for help

ZZXXQQ

回复：chen4 将 _INSERT 改为 -INSERT 即可。

chen4

很好，谢谢ZZXXQQ (COMMAND "_WBLOCK" NMM1 "" "0,0" "C" P1 P2 "") 在CAD2000下"0,0"改为'(0 0)通过， 但改造后，对于一个打开的活动文件，程序运行后，活动文件显示为空白，希望能改进，但不可否认，程序是可行而且思路很高明，这是教科书上学不到的，谢谢!
(DEFUN C:SAVETO ()
(SETvar "CMDECHO" 0)
(COMMAND "UNDO" "C" "N")
(SETQ NMM (strcat (getvar "dwgprefix") (getvar "dwgname")))
(SETQ NMM1 (strcat (getvar "dwgprefix") (getstring "请输入另存文件名：") ".dwg"))
(IF (> (STRLEN NMM) 0)
(PROGN
(COMMAND "-INSERT" (STRCAT "*" NMM) "0,0" "" "")
(COMMAND "ZOOM" "E" "REGEN")
(SETQ P1 (GETvar "EXTMIN") P2 (GETvar "EXTMAX"))
(COMMAND "_circle" P1 40 )

(COMMAND "_WBLOCK" NMM1 "" '(0 0) "C" P1 P2 "")
))
(COMMAND "UNDO" "a") ;;(SETQ NMM1 (GETFILED "Select Second File Name" "" "dwg" 9))
(SETQ NMM1 (strcat (getvar "dwgprefix") (getstring "请输入另存文件名：") ".dwg"))
(IF (> (STRLEN NMM) 0)
(PROGN
(COMMAND "-INSERT" (STRCAT "*" NMM) "0,0" "" "")
(COMMAND "ZOOM" "E" "REGEN")
(SETQ P1 (GETvar "EXTMIN") P2 (GETvar "EXTMAX")) (COMMAND "_rectang" P1 p2)

(COMMAND "_WBLOCK" NMM1 "" '(0 0) "C" P1 P2 "")
))
(COMMAND "UNDO" "a") (SETvar "CMDECHO" 1)
(PRINC)
)

chen4

又是一个晚上，终于找到了一个破绽： 用(command "save" fjm1 acr15_DWG);另存文档 和用(COMMAND "_WBLOCK" NMM1 "" '(0 0) "C" P1 P2 "") 两者均可，但当文件已经存在于目录时，CAD每次都会提示： Yes or No, please.
; error: Function cancelled
A drawing with this name already exists. Do you want to replace it? 而且每次你必须亲手操作才行，这时，循环也就进行不下去， 而且我想在此处谢绝人机对话，用参数给予回答，但都是不成功的。 这个问题，我在上面的 (command "_close" fjm0 )语句中也已经提到。 现在如何用lisp语句来代替手工处理，以使程序照既定的方针进行下去？ 值得大家研究一下，请各位名家高手献计献策，谢谢!

ZZXXQQ

将程序从
(COMMAND "_WBLOCK" NMM1 "" '(0 0) "C" P1 P2 "")
改为
(COMMAND "_WBLOCK NMM1)
(WHILE (NOT (ZEROP (GETVAR "CMDACTIVE"))) (COMMAND "Y"))
(COMMAND "" '(0 0) "C" P1 P2 "")
试一下。