COPYBASE w/ 0,0

March 26, 2018

I wrote 2 lisp routines, but they do not work well. One is to do a copybase at 0,0 and the other is to paste at 0,0.

; ==================================================================================================
(defun c:cpz ()
  (command "_copybase" "0,0" "")
  (princ)
);_defun
; ==================================================================================================
(defun c:pcz ()
  (command "pasteclip" "0,0" "")
  (princ)
);_defun
; ==================================================================================================

How can I improve the code?

Greg

March 27, 2018

Here are some minor improvements:

(defun c:cpz ( / s )
   (if (setq s (ssget)) (command "_.copybase" "_non" '(0 0) s ""))
   (princ)
)
(defun c:pcz ( )
   (command "_.pasteclip" "_non" '(0 0))
   (princ)
)

March 27, 2018

Here are some minor improvements:

(defun c:cpz ( / s )
   (if (setq s (ssget)) (command "_.copybase" "_non" '(0 0) s ""))
   (princ)
)
(defun c:pcz ( )
   (command "_.pasteclip" "_non" '(0 0))
   (princ)
)

Beautiful! Thank you, Sir!

Greg

March 27, 2018

Here are some minor improvements:

(defun c:cpz ( / s )
   (if (setq s (ssget)) (command "_.copybase" "_non" '(0 0) s ""))
   (princ)
)
(defun c:pcz ( )
   (command "_.pasteclip" "_non" '(0 0))
   (princ)
)

I think I understand everything but the "_non". What function does that do?

Greg

March 27, 2018

This is what I use:

;; Copy items to clip board @ 0,0,0
(defun c:cb (/ ss)
 (setvar 'cmdecho 0)
 (if (setq ss (ssget ":L"))
   (progn (if (= 1.0 (car (getvar 'ucsxdir)))
     (command "_.copybase" '(0 0 0) ss "")
     (progn (command "_.ucs" "world")
	    (command "_.copybase" '(0 0 0) ss "")
	    (command "_.ucs" "view")
     )
   )
   (princ (strcat "\n" (itoa (sslength ss)) " items copied to clip board..."))
   )
 )
 (setvar 'cmdecho 1)
 (princ)
)

;; Paste items copied to clip board @ 0,0,0
(defun c:cv nil
 (setvar 'cmdecho 0)
 (if (= 1.0 (car (getvar 'ucsxdir)))
   (command "_.pasteclip" '(0 0 0))
   (progn (command "_.ucs" "world") (command "_.pasteclip" '(0 0 0)) (command "_.ucs" "view"))
 )
 (setvar 'cmdecho 1)
 (princ)
)

March 27, 2018

I think I understand everything but the "_non". What function does that do?

Its to ignore all your OSNAP settings.

March 27, 2018

Its to ignore all your OSNAP settings.

Ahhhhh. Ok, thank you. It makes sense.

Greg

March 27, 2018

I was just about to post something very similar so forgive me if I post in here.

My problem is that I would like to sssetfirst the pasted objects to select them after I paste, should I need to change then straight away in the new drawing or whatnot.

(setq ent (entlast))
(sssetfirst nil ent)

Doesn't work in the below code.

; Created by 3dwannab

; INFO
; 2018.03.27	-	First release

; USAGE
; Copies preselected objects or asks user to select and copies at location 0,0.
; Pastes as clip at 0,0.
; Pastes as block at 0,0.

; COMMANDS
; C0			Copies at 0,0
; P0			Paste as clip at 0,0
; B0			Paste as block at 0,0

; Copies at 0,0
(defun c:C0 ( / ss )

(setq *error* SS:error)
(SS:startundo)

(setq cmde (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)

(progn
	(setq ss (last (ssgetfirst)))
	(if (not ss)
		(setq ss (ssget))
		)
	(if ss
		(progn
			(command "._COPYBASE" "0,0" ss "")
			(princ ":: Copied selected objects @ 0,0 ::")
			)
		(princ "\nUser Cancelled Command")
		)
	)

(*error* nil)
(princ)

)

; Paste clip at 0,0
(defun c:P0 ( / ent )
(command "._PASTECLIP" "0,0")

;; Won't select newly created objects. Is there a way round this?
(setq ent (entlast))
(sssetfirst nil ent)

(princ (strcat "\n::" (itoa (sslength ss)) " Pasted copied objects @ 0,0 ::"))
)

; Paste block at 0,0
(defun c:B0 ( / )
(command "._PASTEBLOCK" "0,0")(princ)
(princ (strcat "\n::" (itoa (sslength ss)) " Pasted copied objects to block definition @ 0,0 ::"))

)

(defun SS:error (errmsg)
(and acDoc (vla-EndUndoMark acDoc))
(and errmsg
	(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
	(princ (strcat "\n<< Error: " errmsg " >>"))
	)
(setvar 'cmdecho cmde)
(setvar 'osmode os)
)

(defun SS:startundo ()
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))
)

(princ
(strcat
	"\n:: 3dwannab_Copy_0_Paste_0.lsp Loaded ::"
	"\n:: Invoke by typing 'C0' 'P0' 'B0' ::"
	)
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

March 27, 2018

; Paste clip at 0,0
(defun c:P0 ( / ent )
(command "._PASTECLIP" "0,0")
 
;; Won't select newly created objects. Is there a way round this?
(setq ent (entlast))

Flanders, before 'pasteclipping' into the new drawing you have to store initially the last created entity(if theres one).

Then you must iterate from it using entnext, and store these enames into your customly created selection set.

And in the end just grip it with sssetfirst.

March 27, 2018

Flanders

lol.

I think I'm close, but struggling now. Tried everything. I'm sure with these two fns by CAB I can achieve what I'm after.

Just lost ATM.

; Paste clip at 0,0
(defun c:P0 ( / LastEntInDatabase)

(command "._COPYBASE" "0,0" pause "")
(command "._PASTECLIP" "0,0")

(setq LastEntInDatabase (GetLastEnt))
(sssetfirst nil (GetNewEntities LastEntInDatabase))

;;  CAB - get last entity in datatbase
(defun GetLastEnt ( / ename result )
	(if (setq result (entlast))
		(while (setq ename (entnext result))
			(setq result ename)
			)
		)
	result
	)
;;===================================
;;  CAB - return a list of new enames
(defun GetNewEntities (ename / new)
	(cond
		((null ename) (alert "Ename nil"))
		((eq 'ENAME (type ename))
			(while (setq ename (entnext ename))
				(if (entget ename) (setq new (cons ename new)))
				)
			)
		((alert "Ename wrong type."))
		)
	new
	)
)

March 28, 2018

lol.

I think I'm close, but struggling now. Tried everything. I'm sure with these two fns by CAB I can achieve what I'm after.

Just lost ATM.

Tried to implement what I wrote into code? You should get the solution (commented for you) :

; Paste clip at 0,0
(defun c:P0 ( / ent SS )
 
 (setq ent (entlast)) ;; attempt to obtain the last created entity from the database
 (command "._PASTECLIP" "0,0") ;; paste the selection from clipboard
 (and 
   (setq SS (ssadd))
   (cond 
     (ent) ;; the drawing had objects, before pasteclipping - hence the last created entity was stored
     ( (setq ent (entnext)) (ssadd ent SS) ) ;; the drawing didn't had any objects (new drawing) - hence obtain the first entity after pasteclipping
   ); cond
   (progn
     (while (setq ent (entnext ent)) (ssadd ent SS))
     (sssetfirst nil SS)
   ); progn
 ); and
(princ (strcat "\n::" (itoa (sslength ss)) " Pasted copied objects @ 0,0 ::"))
 (princ)
); defun c:P0

March 28, 2018

Thanks, I wasn't even close.

I will try to incorporate the UCS recognition from the code above.

; Created by 3dwannab
; A lot of help by Grrr here: http://www.cadtutor.net/forum/showthread.php?103102-COPYBASE-w-0-0&p=699941&viewfull=1#post699941

; INFO
; 2018.03.27	-	First release
; 2018.03.28	-	Help by Grrr to ssgetfirst the pasted items.

; USAGE
; Copies preselected objects or asks user to select and copies at location 0,0.
; Pastes as clip at 0,0.
; Pastes as block at 0,0.

; COMMANDS
; C0			Copies at 0,0
; P0			Paste as clip at 0,0
; B0			Paste as block at 0,0

; Copies at 0,0
(defun c:C0 ( / ss )

(setq *error* SS:error)
(SS:startundo)

(setq cmde (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setvar 'cmdecho 0)
(setvar 'osmode 0)

(progn
	(setq ss (last (ssgetfirst)))
	(if (not ss)
		(setq ss (ssget))
		)
	(if ss
		(progn
			(command "._COPYBASE" "0,0" ss "")
			(princ (strcat "\n   >>>   " (itoa (setq len (sslength ss))) (if (> len 1) " items" " item") " copied @ 0,0   <<<   "))
			)
		(princ "\nUser Cancelled Command")
		)
	)

(*error* nil)
(princ)

)

; Paste clip at 0,0
(defun c:P0 ( / ent SS )
 (setq ent (entlast)) ;; attempt to obtain the last created entity from the database
 (command "._PASTECLIP" "0,0") ;; paste the selection from clipboard
 (and
 	(setq SS (ssadd))
 	(cond
  (ent) ;; the drawing had objects, before pasteclipping - hence the last created entity was stored
  ( (setq ent (entnext)) (ssadd ent SS) ) ;; the drawing didn't had any objects (new drawing) - hence obtain the first entity after pasteclipping
); cond
 	(progn
 		(while (setq ent (entnext ent)) (ssadd ent SS))
 		(sssetfirst nil SS)
); progn
 ); and
 (princ (strcat "\n   >>>   " (itoa (setq len (sslength ss))) (if (> len 1) " items" " item") " pasted @ 0,0   <<<   "))
 (princ)
); defun c:P0

; Paste block at 0,0
(defun c:B0 ( / ent SS )
 (setq ent (entlast)) ;; attempt to obtain the last created entity from the database
 (command "._PASTEBLOCK" "0,0")(princ) ;; paste the selection from clipboard
 (and
 	(setq SS (ssadd))
 	(cond
  (ent) ;; the drawing had objects, before pasteclipping - hence the last created entity was stored
  ( (setq ent (entnext)) (ssadd ent SS) ) ;; the drawing didn't had any objects (new drawing) - hence obtain the first entity after pasteclipping
); cond
 	(progn
 		(while (setq ent (entnext ent)) (ssadd ent SS))
 		(sssetfirst nil SS)
); progn
 ); and
 (princ (strcat "\n   >>>   " (itoa (setq len (sslength ss))) (if (> len 1) " items" " item") " pasted to block definition @ 0,0   <<<   "))
 (princ)
 )

(defun SS:error (errmsg)
(and acDoc (vla-EndUndoMark acDoc))
(and errmsg
	(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
	(princ (strcat "\n<< Error: " errmsg " >>"))
	)
(setvar 'cmdecho cmde)
(setvar 'osmode os)
)

(defun SS:startundo ()
(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc))
)

(princ
(strcat
	"\n:: 3dwannab_Copy_0_Paste_0.lsp Loaded ::"
	"\n:: Invoke by typing 'C0' 'P0' 'B0' ::"
	)
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

;; Copy items to clip board @ 0,0,0
; (defun c:cb (/ ss)
; 	(setvar 'cmdecho 0)
; 	(if (setq ss (ssget ":L"))
; 		(progn (if (= 1.0 (car (getvar 'ucsxdir)))
; 			(command "_.copybase" '(0 0 0) ss "")
; 			(progn (command "_.ucs" "world")
; 				(command "_.copybase" '(0 0 0) ss "")
; 				(command "_.ucs" "view")
; 				)
; 			)
; 		(princ (strcat "\n" (itoa (sslength ss)) " items copied to clip board..."))
; 		)
; 		)
; 	(setvar 'cmdecho 1)
; 	(princ)
; 	)

; ;; Paste items copied to clip board @ 0,0,0
; (defun c:cv nil
; 	(setvar 'cmdecho 0)
; 	(if (= 1.0 (car (getvar 'ucsxdir)))
; 		(command "_.pasteclip" '(0 0 0))
; 		(progn (command "_.ucs" "world") (command "_.pasteclip" '(0 0 0)) (command "_.ucs" "view"))
; 		)
; 	(setvar 'cmdecho 1)
; 	(princ)
; 	)

March 28, 2018

FWIW for the PASTEBLOCK you don't need the same approach:

; Paste block at 0,0
(defun c:B0 ( / ent i )
 
 (command "._PASTEBLOCK" "0,0")(princ) ;; paste the selection from clipboard
 (and
   (setq ent (entlast))
   (sssetfirst nil (ssadd ent))
   (not 
     (vl-catch-all-error-p 
       (setq i 
         (vl-catch-all-apply 'eval
           '(
             (vla-get-Count 
               (vla-Item 
                 (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
                 (vla-get-EffectiveName (vlax-ename->vla-object ent))
               ); vla-Item
             ); vla-get-Count
           )
         ); vl-catch-all-apply 'eval
       ); setq i
     ); vl-catch-all-error-p
   ); not
   (princ (strcat "\n   >>>   " (itoa i) (if (> i 1) " items" " item") " pasted to block definition @ 0,0   <<<   "))
 ); and
 (princ)
); defun

March 28, 2018

Sweet Grrr! That was quick!

March 28, 2018

Alternative:

My 3 CUIX Drop-downs for Copy includes the custom macro "Copy with 0,0 as Base Point"

Macro:

$M=$(if,$(eq,$(substr,$(getvar,cmdnames),1,,GRIP),_copybase,^C^C_copybase) _non 0,0

My 6 CUIX Drop-downs for Paste includes the custom macro "Paste as Group"

Macro:

^C^C_pasteblock;\(setq LstBlk(vla-get-Name (vlax-ename->vla-object (entlast))));_explode;_last;_-group;_create;*;;_previous;;(command "-purge" "B" LstBlk "N")
(setq LstBlk nil)

http://www.cadtutor.net/forum/showthread.php?91042-copy-and-keep-grouped-objects-to-new-dwg&p=625603&viewfull=1#post625603

It Pastes as Block, explodes the Block, creates a group of the exploded objects, then purges that block leaving only the group.

Edited March 30, 2018 by tombu

March 28, 2018

then purges that block leaving only the group.

Nice.

BTW, your signature is the best piece of advice out there.

March 29, 2018

Tried to implement what I wrote into code? You should get the solution (commented for you) :

; Paste clip at 0,0
(defun c:P0 ( / ent SS )
 
 (setq ent (entlast)) ;; attempt to obtain the last created entity from the database
 (command "._PASTECLIP" "0,0") ;; paste the selection from clipboard
 (and 
   (setq SS (ssadd))
   (cond 
     (ent) ;; the drawing had objects, before pasteclipping - hence the last created entity was stored
     ( (setq ent (entnext)) (ssadd ent SS) ) ;; the drawing didn't had any objects (new drawing) - hence obtain the first entity after pasteclipping
   ); cond
   (progn
     (while (setq ent (entnext ent)) (ssadd ent SS))
     (sssetfirst nil SS)
   ); progn
 ); and
(princ (strcat "\n::" (itoa (sslength ss)) " Pasted copied objects @ 0,0 ::"))
 (princ)
); defun c:P0

I'm getting the error: >

Is it good practice to do:

(setq ss nil)

So the top code looks like (see 3 lines from bottom):

; Paste clip at 0,0
(defun c:P0 ( / ent SS )
 
 (setq ent (entlast)) ;; attempt to obtain the last created entity from the database
 (command "._PASTECLIP" "0,0") ;; paste the selection from clipboard
 (and 
   (setq SS (ssadd))
   (cond 
     (ent) ;; the drawing had objects, before pasteclipping - hence the last created entity was stored
     ( (setq ent (entnext)) (ssadd ent SS) ) ;; the drawing didn't had any objects (new drawing) - hence obtain the first entity after pasteclipping
   ); cond
   (progn
     (while (setq ent (entnext ent)) (ssadd ent SS))
     (sssetfirst nil SS)
   ); progn
 ); and
(princ (strcat "\n::" (itoa (sslength ss)) " Pasted copied objects @ 0,0 ::"))
(setq ss nil)
 (princ)
); defun c:P0

March 29, 2018

You'll probably want to exclude subentities from the set, and account for the last entity prior to issuing PASTECLIP also having subentities, e.g.:

(defun c:p0 ( / ent sel tmp )
   (setq ent (entlast)
         sel (ssadd)
   )
   (while (setq tmp (entnext ent)) (setq ent tmp))
   (command "_.pasteclip" "_non" '(0 0))
   (while (setq ent (entnext ent))
       (or (member (cdr (assoc 0 (entget ent))) '("ATTRIB" "VERTEX" "SEQEND"))
           (ssadd ent sel)
       )
   )
   (sssetfirst nil sel)
   (princ)
)

March 29, 2018

Thanks,

I'll try this with the (setq ss nil) and see how it goes.

Is that the solution or is yours the way to go?

March 29, 2018

I'm getting the error: >

I'm only aware of this error, when you try few times to obtain the active selection set via activex without deleting it.

Are you sure that you get the error because of this particular code?

BTW, yea I didn't excluded the subentities, like Lee pointed out.

Sign In

COPYBASE w/ 0,0

Recommended Posts

GregGleason

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Lee Mac

GregGleason

GregGleason

ronjonp

Tharwat

GregGleason

3dwannab

Grrr

3dwannab

Grrr

3dwannab

Grrr

3dwannab

tombu

3dwannab

3dwannab

Lee Mac

3dwannab

Grrr

Join the conversation

Tutorials

Forums

Activity