Topic: Help with a lisp: PASTEORIG in a new document

[PM]

Hi i need help with a lisp code. I want to select everything (only the oplen layers not the close or frozen) from one drawing and paste them with original coordinates in a new document from specific location. I try this code but when open the new document return to the previous and don't  paste the selected part

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ()
2. (ssget "_x" '((410 . "Model")))
3. (command "copyclip" (ssget "_x" '((410 . "Model"))))
4. (setq acApp (vlax-get-acad-object))
5. (setq acDocs (vla-get-documents acApp))
6. (vla-open acDocs "c:\\myfile\\test\\test.dwg")
7. (command "PASTEORIG" "")
8. (princ)
9. )
10.  

Thanks

[Tutulisper]

Hi,you can use "copyobjects " to the new document
this is the code maybe  it useful.

Code - Auto/Visual Lisp: [Select]

1.  
2. (defun c:tes(/ app docs doc objects ss i n sslist)
3.   (setq app (vlax-get-acad-object))
4.   (setq doc (vla-get-activedocument app))
5.   (setq docs (vla-get-documents app))
6.   (setq ss (ssget  (list (cons 410  (Getvar"CTAB" )))))
7.   (setq n (sslength ss)
8.         i 0)
9.   (repeat n
10.     (setq sslist (append sslist (list (vlax-ename->vla-object (ssname ss i)))))
11.     (setq i (1+ i))
12.   )
13.   (setq objects (vlax-make-safearray vlax-vbObject (cons 0  (1- n))))
14.   (vlax-safearray-fill objects sslist)
15.   (setq doc_new (vla-add docs "acad.dwt"))
16.   (vla-copyobjects doc objects (vla-get-modelspace doc_new))
17.   (vla-saveas doc_new "e:\\drawing.dwg")
18.   (vla-close doc_new)
19.   (princ)
20. )
21.  
22.  

[PM]

I have the same layers  in the drawing and the same layers in the dwt but i use different colors in the drawing than in the dwt. When i run the code i miss the colors in the dwt. I want the insert drwing to take the colors from the dwt. Any option ?

[PM]

the first way if better to me ,but i have probleme with the paste in original coordinates.Any option?

Code - Auto/Visual Lisp: [Select]

1. (defun c:test ()
2. (ssget "_x" '((410 . "Model")))
3. (command "copyclip" (ssget "_x" '((410 . "Model"))))
4. (setq acApp (vlax-get-acad-object))
5. (setq acDocs (vla-get-documents acApp))
6. (vla-open acDocs "c:\\myfile\\test\\test.dwg")
7. (command "PASTEORIG" "")
8. (princ)
9. )
10.  
11.  

Thanks

[PM]

Ok i test again Tutulisper and works perfect. I want to add a layon command and a zoom extend command but is not working because when open the new document paste the drawing ,and return to the first drawing and do the lay on and zoom extend in the first drawing. Can any pne help ?

Code - Auto/Visual Lisp: [Select]

1.      
2.     (defun c:tes(/ app docs doc objects ss i n sslist)
3.       (setq app (vlax-get-acad-object))
4.       (setq doc (vla-get-activedocument app))
5.       (setq docs (vla-get-documents app))
6.       (setq ss (ssget  (list (cons 410  (Getvar"CTAB" )))))
7.       (setq n (sslength ss)
8.             i 0)
9.       (repeat n
10.         (setq sslist (append sslist (list (vlax-ename->vla-object (ssname ss i)))))
11.         (setq i (1+ i))
12.       )
13.       (setq objects (vlax-make-safearray vlax-vbObject (cons 0  (1- n))))
14.       (vlax-safearray-fill objects sslist)
15.       (setq doc_new (vla-add docs "acad.dwt"))
16.       (vla-copyobjects doc objects (vla-get-modelspace doc_new))
17.       (vla-saveas doc_new "e:\\drawing.dwg")
18.       (vla-close doc_new)
19.       (princ)
20.     )
21.          
22.  

Thanks

[Tutulisper]

I think lisp can not accitve the new document， so zoom the document have no idea ,the lisp reactor maybe can do it but i can not use it.
this code is only copy the objects to the new document.
you can modify the "lock" "freeze"  state。

Code - Auto/Visual Lisp: [Select]

1. (defun c:tes (/ app docs doc objects ss i n sslist objlay  insyslay  insyslayobj)
2.       (setq app (vlax-get-acad-object))
3.       (setq doc (vla-get-activedocument app))
4.       (setq docs (vla-get-documents app))
5.       (setq modelspaceobjs  (vla-get-ModelSpace doc))
6.       (setq docs (vla-get-documents app))
7.       (vlax-for obj  modelspaceobjs
8.         (setq objlay (Vla-Get-Layer obj))
9.         (setq insyslay (tblobjname "layer" objlay))
10.         (setq insyslayobj (Vlax-Ename->Vla-Object insyslay))
11.         ; if the layer is  on then add to the list
12.         (if (and(= -1 (vlax-get insyslayobj 'layeron));layer is on
13.                 (= 0 (vlax-get insyslayobj 'lock))    ;layer is not lock
14.                 (= 0 (vlax-get insyslayobj 'freeze))  ;;layer is not freeze
15.               )
16.         (progn
17.           (setq sslist (append sslist (list obj)))
18.           )
19.         )
20.       )
21.       (if (> (length sslist) 1 )
22.         (progn
23.       (setq objects (vlax-make-safearray vlax-vbObject (cons 0 (1- (length sslist)))))
24.       (vlax-safearray-fill objects sslist)
25.       (setq doc_new (vla-add docs "acad.dwt"))
26.       (vla-copyobjects doc objects (vla-get-modelspace doc_new))
27.       (vla-saveas doc_new "e:\\drawing.dwg")
28.       (vla-close doc_new)
29.         )
30.       )
31.       (princ)
32.   )
33.  

[PM]

Hi Tutulisper.I try yourr code but my layer ar stay off. Is any other way to do zoom extend and layon the new document ?

[Tutulisper]

can use scr to do it

Code - Auto/Visual Lisp: [Select]

1. (command "._script" scrfilename)
2.  
3. in the scrfile like this code
4. open "e:\drawing.dwg"
5. ZOOM E qsave close
6.  
7.  

[PM]

When the copy the object in the new document return to the previus file. Is any way to go back in the new document and zoom extend and lay on?

[Tutulisper]

Use lisp  do it is difficult i  have no idea.
you can use vba or c# very easy.

[PM]

Thanks for your time.I am not using script files ot vba. I will search more from a solution through lisp.