PDA

View Full Version : Create selection set of newest entities created by copy command



Borg
2004-10-29, 06:50 PM
Let's say that I select a bunch of stuff and copy it. I want to make a selection set
of the new stuff created by the copy command.

Thanks for any and all suggestions. :

CAB2k
2004-10-29, 09:22 PM
You can use this

;;============================================================
; Rune Wold and Michael Puckett - modified
; e.g. usage (setq marker (ALE_LASTENT))
;; Function to get the absolute last entity in the database
;; Returns nil is drawing is completely empty
(defun ALE_LastEnt ( / EntNam OutVal)
(and
(setq OutVal (entlast)); if there is an entity in drawing
(while (setq EntNam (entnext OutVal))
(setq OutVal EntNam)
)
)
OutVal
)
;;============================================================
;; Function to get new items after EntNam in the database
(defun ALE_Ss-After (EntNam / EntNxt SelSet)
(cond
( (not EntNam) (ssget "_X") ); dwg was empty
( (setq EntNxt (entnext EntNam)); get new items
(setq SelSet (ssadd EntNxt))
(while (setq EntNxt (entnext EntNxt))
(if (entget EntNxt) (ssadd EntNxt SelSet))
)
SelSet
)
)
)
;=========================================================

;;=====================================================================
;;=================== Code to get New objects ========================
;;=====================================================================
(setq elast (ALE_LastEnt)); get last entity in database
(setq newbies (ssadd)) ; create an empty selection set
;;
;; Do your array or paste command
;;
(setq newbies (ALE_Ss-After elast))
;; newbies is a selection set of all items created by your command.
;;=====================================================================

Borg
2004-10-29, 09:25 PM
Thanks. I'll give it a try next week.

eddyhgng
2004-11-01, 08:47 AM
how about

(setq sel (ssget))
(command "copy" sel "" "0,0" "0,0" "move" "P" "" pause pause)
(setq sel2 (ssget "p"))

stig.madsen
2004-11-01, 02:42 PM
how about

(setq sel (ssget))
(command "copy" sel "" "0,0" "0,0" "move" "P" "" pause pause)
(setq sel2 (ssget "p"))
No point, really .. sel2 will contain the same selection as sel. I see only two ways, one of which is given above by Ab2draft. The other way is using the ActiveX methods Copy and CopyObjects, which will both return the copied object(s).

Mike.Perry
2004-11-01, 04:28 PM
No point, really .. sel2 will contain the same selection as sel.
Hi

Have you actually tried what "eddyhgng" posted, I think you might be surprised....

Have a good one, Mike

CAB2k
2004-11-01, 04:41 PM
I was surprised, it did work. Not sure I understand why?

stig.madsen
2004-11-01, 06:27 PM
Hi

Have you actually tried what "eddyhgng" posted, I think you might be surprised....

Have a good one, Mike
Yes, line by line. It moves the original objects so that it appears to be the new objects being selected .. kinda like an optical illusion.

Mike.Perry
2004-11-01, 07:03 PM
Yes, line by line. It moves the original objects so that it appears to be the new objects being selected .. kinda like an optical illusion.
Hi Stig

Can you please explain, you've lost me (not difficult I know).

:beer: Mike

Borg
2004-11-01, 07:19 PM
Reply to Eddyhgng:

Thanks for your input.
What I'm trying to do is create a rector(this part is done) that reacts on the copy command.
It will then iterate through all of the new objects created by said command to check for blocks of a particular name.

I should be able to incorporate the code AB2DRAFT to make this happens.
Your code is valid but I don't wan't to redefine the copy command.

stig.madsen
2004-11-01, 07:19 PM
Sure Mike. The task was to "make a selection set of the new stuff created by the copy command" - not to return the original objects. This makes perfect sense because the original objects can be involved in intelligent operations, which can be depending on handles, enames, selections, groups, attribute data, draworder or whatever .. making it a good thing to keep the originals untouched.

(setq sel (ssget))
-> sets sel to contain some objects

(command "copy" sel "" "0,0" "0,0" "move" "P" "" pause pause)
-> copies objects in sel - then moves previously selected objects, which are equal to the objects in sel

(setq sel2 (ssget "p"))
-> grabs previously selected objects, which again are equal to the original objects in sel


We are used to move the new objects within the COPY command. This snippet simply plays a trick on us because it moves the original objects instead. Check the enames in sel and sel2 .. they will be identical.

Here's a small thing to print out enames from a selection set:


(defun EntsOut (ss / a)
(setq a 0)
(repeat (sslength ss)
(princ (ssname ss a)) (terpri)(setq a (1+ a)))
(princ)
)

Mike.Perry
2004-11-01, 07:35 PM
Hi Stig

Thanks for the clear explanation (even I understood that).

:beer: Mike

ps I should've known better to tackle a LISP Master....

kennet.sjoberg
2004-11-01, 11:59 PM
And here is an other way to understand
- draw a line, dimension the line with associative dimension
copy the line and then move previous . . . bee unhappy
- draw a line, dimension the line with associative dimension
copy the line with copy2 and then move previous . . . bee happy


(defun C:copy2 ( / OldCmd LastEnt SelSet1 SelSet2 Ent )
;;; Select a bunch of stuff and copy it. This one make a selection set of the new stuff,
;;; and put it in to Previous. / kennet
(setq OldCmd (getvar "CMDECHO" ) )
(setq LastEnt (entlast) ) ;; place holder
(setq SelSet1 (ssget) )
(setvar "CMDECHO" 1 )
(command "._copy" SelSet1 "" )
(while (= 1 (logand (getvar "CMDACTIVE" ) 1 ) ) (command PAUSE ) )
(setvar "CMDECHO" OldCmd )
(setq SelSet2 (ssadd) ) ;; create an empty selection set
(setq Ent LastEnt )
(while (setq Ent (entnext Ent ) ) ;; Step through new entities
(ssadd Ent SelSet2 ) ;; add to selection set
)
(command "select" SelSet2 "" )
(princ "\You will find the new stuff in Previous, try Command: move p" )
(princ)
)

: ) Happy Computing !

kennet

Tom Beauford
2004-11-03, 07:09 PM
How about using your reactor to (setq e1 (entlast), then upon close create your selection set by looping (entnext) begining with (entnext e1).

What I'm trying to do is create a rector(this part is done) that reacts on the copy command.
It will then iterate through all of the new objects created by said command to check for blocks of a particular name.

I should be able to incorporate the code AB2DRAFT to make this happens.
Your code is valid but I don't wan't to redefine the copy command.

stig.madsen
2004-11-03, 11:35 PM
The natural way to detect new objects would probably be a database reactor but you could try to have some fun with a command reactor. It's definately easier to work with. I'd just suggest that you use ActiveX for all your entity handling calls. Reason being that reactors can get serious hickups from the ENTxxx functions (especially, but not exclusively, when it needs to create objects).

Below is a simple scheme for such a reactor. It's set to fire on :vlr-commandWillStart and on :vlr-commandEnded. When a command starts, it runs the PUTCMD routine that does this:

- check to see if a COPY command is issued
- if so, get the total count of objects in the drawing (in this case, the space where the command was issued)
- put the total count of objects into its own data field

The data field of a reactor can be used for any arbitrary data that you may find suitable. It's good for carrying around data (if it can be garanteed that data doesn't go out of scope, of course).

When a command has ended, it fires again and runs the GETCMD routine. It does the following:

- check to see if a COPY command was issued
- if so, get the object count from before the COPY command did anything
- get the present count of objects in the active space
- run through each new object based on these counts
- see if it is a block and see if it matches a list of (hardcoded) names
- report any instances of new blocks of specified names

It should probably have some error catching tossed in here and there but you can play around with that part, also. To install the reactor, first run the INSTALLCMDREACTOR routine. It'll set up the reactor and assign a global variable. To kill it, use the standard VLR-REMOVE(-ALL) functions.


(defun installCmdReactor ()
(if (or (not gCmdReactor) (vl-catch-all-error-p
(vl-catch-all-apply 'vlr-added-p (list gCmdReactor)))
)
(setq gCmdReactor (vlr-command-reactor nil
'((:vlr-commandWillStart . putCmd)
(:vlr-commandEnded . getCmd)
)
)
)
)
)

(defun putCmd (vlr cmdInfo / doc space)
(cond
;; if a COPY command is detected
((member "COPY" cmdInfo)
;; then get the active space
(if (zerop (vla-get-activeSpace
(setq doc (vla-get-activedocument (vlax-get-acad-object)))))
(setq space (vla-get-paperspace doc))
(setq space (vla-get-modelspace doc))
)
;; and put the object count in the data field
(vlr-data-set vlr (1- (vla-get-count space)))
;; release some object references
(vlax-release-object space)
(vlax-release-object doc)
)
)
)

(defun getCmd (vlr cmdInfo / cnt copiedblocks doc index item space)
(cond
;; if a COPY is just done
((and (member "COPY" cmdInfo)
;; and it's data field holds a number
(numberp (setq index (vlr-data vlr)))
)
(setq copiedBlocks 0)
;; then get active space
(if (zerop
(vla-get-activeSpace
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
)
)
(setq space (vla-get-paperspace doc))
(setq space (vla-get-modelspace doc))
)
;; get the current object count
(setq cnt (1- (vla-get-count space)))
;; report some silly info just for fun
(princ (strcat "\n" (itoa (- cnt index)) " object(s) created in total"))
;; step through all objects added since index
(while (<= (1+ index) cnt)
(setq item (vla-item space (setq index (1+ index))))
;; check if it's a block reference
(cond ((and (= (vla-get-objectName item) "AcDbBlockReference")
;; and if it has a name on the most-wanted list
(member (vla-get-name item) '("myBlockName" "addMoreOwnBlocksIfYouWant"))
)
;; if so, increment detected-block counter
(setq copiedBlocks (1+ copiedBlocks))
)
)
)
;; report the real stuff we want
(princ (strcat "\n" (itoa copiedBlocks) " special block(s) detected"))
;; release some object references
(vlax-release-object space)
(vlax-release-object doc)
)
)
;; just to be safe, clear the field
(vlr-data-set vlr nil)
)

V@no
2015-03-15, 09:08 AM
how about

(setq sel (ssget))
(command "copy" sel "" "0,0" "0,0" "move" "P" "" pause pause)
(setq sel2 (ssget "p"))
In my tests on AutoCAD 2000i it still selects the original object. Any ideas why?

V@no
2015-03-15, 05:02 PM
how about

(setq sel (ssget))
(command "copy" sel "" "0,0" "0,0" "move" "P" "" pause pause)
(setq sel2 (ssget "p"))

In AutoCAD 2000i it would start the move command but user would have to finish it by clicking where to move the object to, so I changed it to:

(command "copy" sel "" "0,0" "0,0" "move" "P" "" "0,0" "@")

That become automatic, however sel2 has the same selection as sel. Any more ideas?

Thank you.

P.S. trying avoid using VisualAutoLisp.

Tom Beauford
2015-03-16, 10:32 AM
Check out Irné Barnard's SelectResults.lsp:
http://forums.augi.com/showthread.php?81175-select-result-lisp-modification#5
It stores the Results of as many previous commands as you set. I load it with AcadDoc.lsp and added it as a macro to my collection of selection methods.

alane
2015-03-16, 03:23 PM
I found the lisp below in this thread and tried to modify it to repeat, which it does for two instances. Any idea how to get it to repeat until escape is used?

The code is:

(defun C:CC ( / OldCmd LastEnt SelSet1 SelSet2 Ent )

(setq OldCmd (getvar "CMDECHO" ) )
(setq LastEnt (entlast) ) ;; place holder
(setq SelSet1 (ssget) )
(setvar "CMDECHO" 1 )
(command "._COPY" SelSet1 "" )
(while (= 1 (logand (getvar "CMDACTIVE" ) 1 ) ) (command PAUSE ) )
(setvar "CMDECHO" OldCmd )
(setq SelSet2 (ssadd) ) ;; create an empty selection set
(setq Ent LastEnt )
(while (setq Ent (entnext Ent ) ) ;; Step through new entities
(ssadd Ent SelSet2 ) ;; add to selection set
)
(command "select" SelSet2 "" )
(command "._COPY" SelSet2 "" "@" )
(princ "\You will find the new stuff in Previous, try Command: move p" )
(princ)
)

Thanks

Ashley

peter
2015-03-16, 06:18 PM
I played around with it and found this worked adequately.

Personally I would avoid the command pipe and do this with ActiveX.

P=


(defun C:CC ( / intCmdEcho
entLast1
lstLastPoint
ssSelections1
)
(setq intCmdEcho (getvar "cmdecho"))
(setq ssSelections1 (ssget))
(while (and
(setq entLast1 (entlast))
(setvar "cmdecho" 1)
(vl-cmdf "._Copy" ssSelections1 "")
(setvar "cmdecho" intCmdEcho)
(if lstLastPoint
(vl-cmdf lstLastPoint)
(vl-cmdf pause)
)

(vl-cmdf pause)
)
(setq ssSelections1 (ssadd))
(while (setq entLast1 (entnext entLast1))
(ssadd entLast1 ssSelections1)
)
(setq lstLastPoint (getvar "lastpoint"))
)
(princ)
)
(vl-load-com)

peter
2015-03-16, 10:59 PM
I thought it might be interesting to revisit some old code I had.

In it... I create the new selection set option for select objects.

Two limitations.
There needs to be at least one item in a layout before you can select new
You must type a single quote before the N so it would be

Select objects: 'N

Comments and questions are encouraged.

P=



;___________________________________________________________________________________________________________
;
; Reactor Based Function to Create a NEW selection set option
; available at the select objects prompt as 'N (a single quote and the letter N)
; Written By: Peter Jamtgaard copyright 2015 All rights reserved
;___________________________________________________________________________________________________________

; This routine returns a selection set of newest selection set.
(defun C:N (/ colNewSelectionSet intCount ssSelections)
(if (and
(setq objDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq colSelectionsSets (vla-get-selectionsets objDocument))
(errortrap '(setq colSelectionSet (vla-item colSelectionSets "NEW")))
(> (vla-get-count colSelectionSet) 0)
(setq ssSelections (ssadd))
)
(errortrap '(vlax-map-collection colSelectionSet 'MapSelections))
)
ssSelections
)


;___________________________________________________________________________________________________________
;
; Function to add an object to a selection set called ssSelections
;___________________________________________________________________________________________________________

(defun MapSelections (objItem)
(ssadd (vlax-vla-object->ename objItem) ssSelections)
)


;___________________________________________________________________________________________________________
;
; Function to query a drawing and locate the last object in each layout.
; It returns a list of the sublists
; Each sublist contains the layoutname, number of items in a layout and the vla-object of the last item.
;___________________________________________________________________________________________________________

(defun NewObjects (rxncall callback / colBlock intCount objLayout)
(setq lstLastObjects nil)
(vlax-for objLayout (vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)))
(setq colBlock (vla-get-block objLayout))
(if (> (setq intCount (vla-get-count colBlock)) 0)
(setq lstLastObjects (cons (list (vla-get-name objLayout)
intCount
(vla-item colBlock (1- intCount))
)
lstLastObjects
)
)
)
)
(print lstLastObjects)
)


;___________________________________________________________________________________________________________
;
; Initialize commandwillstart reactor (for new objects)
;___________________________________________________________________________________________________________

(or
rxnCommandWillStartSS
(setq rxnCommandWillStartSS (vlr-editor-reactor nil '((:vlr-commandwillstart . NewObjects))))
)


;___________________________________________________________________________________________________________
;
; Function to determine the new objects in the active layout and add them to an
; activeX selection set called "NEW"
;___________________________________________________________________________________________________________

(defun NewSelectionSet (rxnCall Callback /
colSelectionSet
colSelectionSets
intItem
lstNewObjects
lstSubList
objDocument
objLast
objLayout
strLayoutName
)
(and
(setq objDocument (vla-get-activedocument (vlax-get-acad-object)))
(setq objLayout (vla-get-activelayout objDocument))
(setq strLayoutName (vla-get-name objLayout))
(setq lstSubList (assoc strLayoutName lstLastObjects))
(> (vla-get-count (vla-get-block objLayout)) (cadr lstSublist))
(setq objLast (caddr lstSublist))
(setq colSelectionSets (vla-get-selectionsets objDocument))
(or (errortrap '(setq colSelectionSet (vla-add colSelectionSets "NEW")))
(and (errortrap '(setq colSelectionSet (vla-item colSelectionSets "NEW")))
(errortrap '(vla-clear colSelectionSet))
)
)
(setq lstNewObjects (ItemsNew objLast))
(print lstNewObjects)
(errortrap '(vla-additems colSelectionSet (listtovariantsafearray vlax-vbobject (reverse lstNewObjects))))
(errortrap '(vla-highlight colSelectionSet 1))
)
)


;___________________________________________________________________________________________________________
;
; Toolbox function to convert a list to a variant safearray (needed for the
; additems method of ActiveX Selection Set
;___________________________________________________________________________________________________________

(defun ListToVariantSafeArray (symSafeArrayType lstItems / safArray)
(setq safArray (vlax-make-safearray symSafeArrayType (cons 0 (1- (length lstItems)))))
(vlax-safearray-fill safArray lstItems)
(variant safArray)
)


;___________________________________________________________________________________________________________
;
; Function to build a list of new objects give the last object in a layout
;___________________________________________________________________________________________________________

(defun ItemsNew (objItem / entItem lstNewObjects objNewItem)
(if (setq entItem (vlax-vla-object->ename objItem))
(while (setq entItem (entnext entItem))
(setq objNewItem (vlax-ename->vla-object entItem))
(setq lstNewObjects (cons objNewItem lstNewObjects))
)
)
(reverse lstNewObjects)
)


;___________________________________________________________________________________________________________
;
; Initialize commandended reactor (to build "NEW" selection set)
;___________________________________________________________________________________________________________

(or
rxnCommandEndedSS
(setq rxnCommandEndedSS (vlr-editor-reactor nil '((:vlr-commandended . NewSelectionSet))))
)

;___________________________________________________________________________________________________________
;
; General Errortrap function
;___________________________________________________________________________________________________________

(defun ErrorTrap (symFunction / objError result)
(if (vl-catch-all-error-p
(setq objError (vl-catch-all-apply
'(lambda (XYZ123)(set XYX123 (eval symFunction)))
(list 'result))))
nil
(if result result 'T)
)
)

(vl-load-com)