[原创]原位置COPY物件到其它圖檔
;|My intention is to:
1. 'copyclip' some features from this drawing.
2. Open another drawing
3. Paste the copied features into the newly opened drawing.
4. Save and close this new drawing.
5. Get back to the old drawing and continue to repeat the cycle.Tried as follows till step 3:
(defun c:cp()
(setq sset (ssget)) ;from current drawing
(command "copyclip" sset "")
(command "._VBAStmt" (strcat "AcadApplication.Documents.Open \"" "c:/junk.dwg" "\"")
(command "pasteorig") ;does not work in new drawing.
)As soon as the new drawing is opened, it becomes the current. But,
the line (command "pasteorig") does not get executed here since the program belongs to old drawing.
Any tips on what to do so that I can continue to perform the steps 3, 4, 5?
|;
;;BY LUCAS(龙龙仔)
;;原位置COPY物件到其它图档
(defun C:COPY_2_OTHER_DWG (/ DOC LST N NEWDWG SS NAME)
(vl-load-com)
(if (and (setq SS (ssget (list (cons 410 (getvar "ctab"))
(cons 0 (strcat "~" "VIEWPORT"))
)
)
)
(setq NAME (getfiled "开启图档" (getvar "ACADPREFIX") "dwg" 8))
(setq NAME (findfile NAME))
)
(progn
(setq N -1
DOC (vla-get-activedocument (vlax-get-acad-object))
NEWDWG (vla-open (vla-get-documents (vlax-get-acad-object))
NAME
)
)
(repeat (sslength SS)
(setq LST
(cons (vlax-ename->vla-object (ssname SS (setq N (1+ N))))
LST
)
)
)
(vla-copyobjects
DOC
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length LST)))
)
LST
)
(if (equal (getvar "ctab") "Model")
(vla-get-modelspace NEWDWG)
(vla-get-paperspace NEWDWG)
)
)
(vla-saveas NEWDWG NAME acnative)
(vla-close NEWDWG)
(vlax-release-object DOC)
(vlax-release-object NEWDWG)
)
)
(princ)
)
cad自带这个功能，编辑菜单里的粘贴到原坐标，有区别吗？？？ 当你要copy到所有图中时,程序只要执行一下(当然程序要修改)
页:
[1]