[原创]原位置COPY物件到其它圖檔

龙龙仔

2. ;|
3. My intention is to:
4. 1. 'copyclip' some features from this drawing.
5. 2. Open another drawing
6. 3. Paste the copied features into the newly opened drawing.
7. 4. Save and close this new drawing.
8. 5. Get back to the old drawing and continue to repeat the cycle.Tried as follows till step 3:
9. (defun c:cp()
10. (setq sset (ssget)) ;from current drawing
11. (command "copyclip" sset "")
12. (command "._VBAStmt" (strcat "AcadApplication.Documents.Open "" "c:/junk.dwg" """)
13. (command "pasteorig") ;does not work in new drawing.
14. )As soon as the new drawing is opened, it becomes the current. But,
15. the line (command "pasteorig") does not get executed here since the program belongs to old drawing.
16. Any tips on what to do so that I can continue to perform the steps 3, 4, 5?
17. |;
18. ;;BY LUCAS(龙龙仔)
19. ;;原位置COPY物件到其它图档
20. (defun C:COPY_2_OTHER_DWG (/ DOC LST N NEWDWG SS NAME)
21.    (vl-load-com)
22.    (if (and (setq SS (ssget (list (cons 410 (getvar "ctab"))
23.          (cons 0 (strcat "~" "VIEWPORT"))
24.            )
25.            )
26.        )
27.        (setq NAME (getfiled "开启图档" (getvar "ACADPREFIX") "dwg" 8))
28.        (setq NAME (findfile NAME))
29.            )
30.        (progn
31.            (setq N       -1
32.          DOC       (vla-get-activedocument (vlax-get-acad-object))
33.          NEWDWG (vla-open (vla-get-documents (vlax-get-acad-object))
34.                NAME
35.          )
36.            )
37.            (repeat (sslength SS)
38.   (setq LST
39.                (cons (vlax-ename->vla-object (ssname SS (setq N (1+ N))))
40.              LST
41.                )
42.   )
43.            )
44.            (vla-copyobjects
45.   DOC
46.   (vlax-safearray-fill
47.      (vlax-make-safearray
48.          vlax-vbobject
49.          (cons 0 (1- (length LST)))
50.      )
51.      LST
52.   )
53.   (if (equal (getvar "ctab") "Model")
54.      (vla-get-modelspace NEWDWG)
55.      (vla-get-paperspace NEWDWG)
56.   )
57.            )
58.            (vla-saveas NEWDWG NAME acnative)
59.            (vla-close NEWDWG)
60.            (vlax-release-object DOC)
61.            (vlax-release-object NEWDWG)
62.        )
63.    )
64.    (princ)
65. )

;| 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) )

clty

cad自带这个功能，编辑菜单里的粘贴到原坐标，有区别吗？？？

龙龙仔

当你要copy到所有图中时,程序只要执行一下(当然程序要修改)