Command: COPYBETWEENSESSIONS
This test function copies selected objects between opened documents (that is- between active spaces of those documents). Can be helpful when Ctrl+C / Ctrl+V stops working or when the user wants to copy objects to multiple documents at once.
Code:
;;; ================================================
;;; COPY_BETWEEN_SESSIONS_v2_00.LSP
;;;
;;; Written by Andrzej Kalinowski, www.autolisps.blogspot.com
;;; v1.00 - 12.04.2020 - first release
;;; v1.01 - 22.05.2020 - fixed bug with second session = nil
;;; v2.00 - 31.01.2025 - added DCL window to select multiple documents
;;;
;;; Command: COPYBETWEENSESSIONS
;;; This function copies selected objects between opened documents (it is- between activespaces of those documents)
;;; Program has limitation to two opened sessions
;;;
;;; ================================================
(defun c:COPYBETWEENSESSIONS ( / ss1 i1 vlaObjLst curobj1 actDoc1 safArr1 docLst actspc2 doc1 TrgtDoc1 TitleLst)
;about vla-copyobjects
;https://knowledge.autodesk.com/es/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2016/ESP/AutoCAD-ActiveX/files/GUID-D9E0A89C-2D81-4141-8B88-B9AC6EAABD62-htm.html
(if (setq ss1 (ssget) )
(progn
;-----------------------------------------
;creating list of vla-objects from selection set
;-----------------------------------------
(repeat (setq i1 (sslength ss1) )
(setq i1 (1- i1) )
(setq curobj1 (vlax-ename->vla-object (ssname ss1 i1) ) )
(setq vlaObjLst (cons curobj1 vlaObjLst) )
);repeat
(setq safArr1 (vlax-make-safearray vlax-vbObject (cons 0 (1- (length vlaObjLst))) ) )
(vlax-safearray-fill safArr1 vlaObjLst)
;-----------------------------------------
;getting documents
;-----------------------------------------
(setq actDoc1 (vla-get-activedocument (vlax-get-acad-object)));activeDoc1
(setq docLst (list) TitleLst (list))
(vlax-for doc1
(vla-get-documents (vlax-get-acad-object) ) ;collection
(if (/=
(vlax-get doc1 "WindowTitle")
(vlax-get (vla-get-activedocument (vlax-get-acad-object)) "WindowTitle");active document title
)
(setq docLst (cons doc1 docLst) )
);if
);vlax-for
(foreach curobj1 docLst (setq TitleLst (cons (vlax-get curobj1 "WindowTitle") TitleLst) ) )
(cond
( (= (length docLst ) 0) (progn (alert "\nThere are no other opened sessions.") (exit) ) )
( (> (length docLst ) 1) (CBS_DCL TitleLst) )
);cond
(foreach TrgtDoc1 docLst
(if (member (vlax-get TrgtDoc1 "WindowTitle") TitleLst)
(progn
;-----------------------------------------
;getting active space in second document
;-----------------------------------------
(setq actspc2 (vla-get-activespace TrgtDoc1 ) ); returns 1 - model; 0-paperspace
(if (= actspc2 1)
(setq actspc2 (vla-get-modelspace TrgtDoc1 ) )
(setq actspc2 (vla-get-paperspace TrgtDoc1 ) )
);if
;(setq lyouts2 (vla-get-layouts TrgtDoc1 ) )
;(vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)) )
;(setq actspc2 (vla-get-activespace TrgtDoc1 ) )
;(vla-get-path (vla-get-activedocument (vlax-get-acad-object)) )
;(vla-get-fullname (vla-get-activedocument (vlax-get-acad-object)) )
;(vlax-dump-object (vla-get-documents (vlax-get-acad-object) ))
;-----------------------------------------
;copying objects
;-----------------------------------------
(vla-copyobjects
actDoc1 ;this document
safArr1 ; our collection to be copied
actspc2 ;destination place (can be model or layout in current document or in another document.)
);vla-copyobjects
);progn
);if
);foreach
(if (= (length docLst ) 1) (vla-put-activedocument (vlax-get-acad-object) (car docLst )))
);progn
);if
(princ)
);defun
(defun CBS_DCL ( TitleLst / tmpfpath1 infile1 dcl_id DBwid DBhi item2 n1)
;-----------------------------------------
;defining wigth and height of the list (length and height of the list dependant of the content of the TitleLst)
;-----------------------------------------
(setq DBwid 7 DBhi 10);here wi set minimal width of our Dialog Box
(foreach item2 TitleLst (if (> (strlen item2) DBwid) (setq DBwid (fix (* 1.2 (strlen item2) ) ) )))
(if (> DBwid 140) (setq DBwid 140 ))
(if (> (length TitleLst) (- DBhi 5)) (setq DBhi (fix (* 1.5 (length TitleLst)))) )
(setq DBwid (itoa DBwid) DBhi (itoa DBhi))
;-----------------------------------------
(setq tmpfpath1 (strcat (getvar "MYDOCUMENTSPREFIX") "\\TEMP1DCL.DCL") )
(setq infile1 (open tmpfpath1 "w") )
(write-line
(strcat "
CBS_DIALOG : dialog
{ label = \"COPYBETWEENSESSIONS v2.00\";
: row
: boxed_column
{ label =\"Select drawings:\";
: list_box
{
key = list_key;
width = " DBwid " ;
height = " DBhi " ;
multiple_select = true;
allow_accept = true;
value = 0;
}
}
: text {label =\"\"; }
: row
{
: button { key = updates_key; label = \"Check for updates\"; width = 2 ;fixed_width = true;}
ok_cancel;
}
: text {label =\"autolisps.blogspot.com\"; }
}"
);strcat
infile1
);write line
(close infile1)
;-----------------------------------------
; loading DCL
;-----------------------------------------
(setq dcl_id (load_dialog tmpfpath1) )
(if (not (new_dialog "CBS_DIALOG" dcl_id) ) (exit) )
;-----------------------------------------
; creating a list to be displayed in the list box. Exaple from:
;https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2016/ENU/AutoCAD-AutoLISP/files/GUID-9BF538FC-BB15-4843-9796-DDCDB6D38C8E-htm.html
;-----------------------------------------
(start_list "list_key" 3);Starts the processing of a list in the list box or in the pop-up list dialog box tile
;|
A numeric value indicating the type of list operation to perform. You can specify one of the following:
1 -- Change selected list contents
2 -- Append new list entry
3 -- Delete old list and create new list (the default)
|;
(mapcar 'add_list TitleLst)
(end_list);Ends processing of the currently active dialog box list. This function is the complement of start_list.
(set_tile "list_key" "0")
(mode_tile "list_key" 2);sets focus on tile
;-----------------------------------------
(setq itemNRs "0" n1 1)
(repeat (- (length TitleLst) 1) (setq itemNRs (strcat itemNRs " " (itoa n1) ) n1 (1+ n1) ) )
(action_tile "updates_key" "(startapp \"explorer\" \"http://autolisps.blogspot.com/p/copybetweensessions.html\")")
(action_tile "accept" "(setq TitleLst (CBS_GETFINALLIST TitleLst)) (done_dialog)" )
(action_tile "cancel" "(done_dialog) (vl-file-delete tmpfpath1) (exit)" )
(start_dialog);displays dialog box
(unload_dialog dcl_id)
(vl-file-delete tmpfpath1)
);defun
;;; ==================================================================
; CBS_GETFINALLIST
;;; ==================================================================
(defun CBS_GETFINALLIST (lst01 / NrSelItms spacepoz tmplst1 elm1 elm2 AdPhr1 great1 less1 FinaList1)
;NrSelItms is a list of numbers with spaces between them
;lst01 is a list without number of items
(setq
NrSelItms (get_tile "list_key");Nubers of selected items from lst01 (STRING type) fe. "0 3 4 15"
NrSelItms (strcat NrSelItms " ");adding space at the end of the string to prevent loop stopping before the last element
FinaList1 (list);empty list to store elements selected in dialog box
spacepoz (vl-string-position (ascii " ") NrSelItms)
);setq
(if (/= NrSelItms " ") ;prevents from error when nothing in the list is selected. If NrSelItms = " " then it menas nothing in the list was selected.
(while (/= NrSelItms "");loop unitl NrSelItms has no spaces
(setq
FinaList1 (append FinaList1 (list (nth (read NrSelItms) lst01) ) )
spacepoz (vl-string-position (ascii " ") NrSelItms)
);setq
(if (= spacepoz nil);this function prevents passing nil to (+ spacepoz 2) function
(setq spacepoz "")
(setq NrSelItms (substr NrSelItms (+ spacepoz 2) ) );setq
);if
);while
);if
(if (>(length FinaList1) 0 ) (setq FinaList1 (acad_strlsort FinaList1) ))
FinaList1
);defun
Example:
1.00 - 12.04.2020 - first release
1.01 - 22.05.2020 - fixed bug with second session = nil
2.00 - 31.01.2025 - added DCL window to select multiple documents
Compatibility:
-All Autocad versions
Remarks:
-The application comes with the long command names listed above. To create your own short aliases for these commands, go to ACAD.PGP file or Menu Manage->Customization->Edit aliases->Edit Aliases.
Download file: COPY_BETWEEN_SESSIONS_v2_00.FAS
No comments:
Post a Comment