Quickly bashed together from existing code. Use and abuse to suit:
(progn
(defun _Doc ( )
(vl-load-com)
(setq *doc* (vla-get-activedocument (vlax-get-acad-object)))
(defun _Doc ( ) *doc*)
*doc*
)
(defun _Try ( try_statement / try_result )
(vl-catch-all-apply
(function
(lambda ( )
(setq try_result (eval try_statement))
)
)
)
try_result
)
(defun _Item ( collection key )
(_Try '(vla-item collection key))
)
(defun _MakeKey ( collection / prefix result i )
(setq
prefix "$temp"
result prefix
i 0
)
(while (_Item collection result)
(setq result (strcat prefix "_" (itoa (setq i (1+ i)))))
)
result
)
(defun _PushUCS ( / key )
(setq key (_MakeKey (vla-get-usercoordinatesystems (_Doc))))
(vl-cmdf ".ucs" "_save" key)
key
)
(defun _PopUCS ( key )
;; Caller's responsibility to pass valid key.
(vl-cmdf ".ucs" "_restore" key)
(vl-cmdf ".ucs" "_delete" key)
(princ)
)
(defun c:CB ( / cmdecho ucs ss )
(if (setq ss (ssget))
(progn
(setq cmdecho (getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq ucs (_PushUCS))
(command ".ucs" "_world")
(_Try '(vl-cmdf ".copybase" "_non" "0,0,0" ss ""))
(_PopUCS ucs)
(setvar 'cmdecho cmdecho)
)
)
(princ)
)
(defun c:PB ( / cmdecho ucs elev )
(setq
cmdecho (getvar 'cmdecho)
elev (getvar 'elevation)
)
(setvar 'cmdecho 0)
(setvar 'elevation 0.0)
(setq ucs (_PushUCS))
(command ".ucs" "_world")
(_Try '(vl-cmdf ".pasteclip" "_non" "0,0"))
(_PopUCS ucs)
(setvar 'cmdecho cmdecho)
(setvar 'elevation elev)
(princ)
)
(princ)
)
FWIW, Cheers and good luck, MP.