selecting object globally

[mruPRQUJ]

Hi there,

The below lisp is used to replace object with another object, but it is needed to select each single object which will be replaced. Is it possible to select only once? and all the same kind of objects will be selected. Please see the lisp below, thank you very much in advance. 🙂

; FRTO - Fast Replace Through Object
; Original code posted here: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21048Af

(defun c:frto (/ ACTDOC COPOBJ ERRCOUNT EXTLST EXTSET FROMCEN LAYCOL MAXPT CURLAY MINPT OBJLAY OKCOUNT OLAYST SCLAY TOCEN TOOBJ VLAOBJ *ERROR* ASK)
(vl-load-com)

; Define error handler
(defun *ERROR* (msg)
(if OLAYST (vla-put-Lock OBJLAY OLAYST))
(vla-EndUndoMark ACTDOC)
(princ)
)

; Function to get the center of bounding box of a VLA object
(defun GetBoundingCenter (VLAOBJ / BLPT TRPT CNPT)
(vla-GetBoundingBox VLAOBJ 'MINPT 'MAXPT)
(setq
BLPT (vlax-safearray->list MINPT)
TRPT (vlax-safearray->list MAXPT)
CNPT (vlax-3D-point
(list
(+ (car BLPT) (/ (- (car TRPT) (car BLPT)) 2))
(+ (cadr BLPT) (/ (- (cadr TRPT) (cadr BLPT)) 2))
(+ (caddr BLPT) (/ (- (caddr TRPT) (caddr BLPT)) 2))
)
)
)
)

; Function to copy specified properties from one entity to another
(defun _kpblc-ent-properties-copy (SOURCE DEST)
(foreach prop
'("Angle" "Layer" "Linetype" "LinetypeScale" "Lineweight"
"Normal" "PlotStyleName" "Thickness" "Color" "Visible"
"Closed" ; "ConstantWidth" (not copied)
; "Elevation" "LinetypeGeneration"
; "LinetypeScale" "StartAngle" "EndAngle" (not copied)
; "Alignment"
"Backward" "Height" "ObliqueAngle" "Rotation" "ScaleFactor" "StyleName"
"TextGenerationFlag" "TextHeight" "UpsideDown" "AttachmentPoint" "BackgroundFill"
"DrawingDirection" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle" "Width"
"XScaleFactor" "YScaleFactor" "ZScaleFactor"
; Viewport
; "ArcSmoothness" "CustomScale"
"Direction" "DisplayLocked" "GridOn" "LensLength" "ModelView" "ShadePlot" "SheetView"
"SnapBasePoint" "SnapOn" "SnapRotationAngle" "StandardScale" "Target" "TwistAngle"
"UCSIconAtOrigin" "UCSIconOn" "UCSPerViewport" "ViewportOn"
)
(if (and (vlax-property-available-p SOURCE prop) (vlax-property-available-p DEST prop t))
(_kpblc-error-catch
'(lambda () (vlax-put-property DEST prop (vlax-get-property SOURCE prop)))
nil
)
)
)
)

; Error handling function
(defun _kpblc-error-catch (PROTECTED-FUNCTION ON-ERROR-FUNCTION / CATCH_ERROR_RESULT)
(setq CATCH_ERROR_RESULT (vl-catch-all-apply PROTECTED-FUNCTION))
(if (and (vl-catch-all-error-p CATCH_ERROR_RESULT) ON-ERROR-FUNCTION)
(apply ON-ERROR-FUNCTION (list (vl-catch-all-error-message CATCH_ERROR_RESULT)))
CATCH_ERROR_RESULT
)
)

; Get the active document
(setq ACTDOC (vla-get-ActiveDocument (vlax-get-Acad-object)))
(vla-StartUndoMark ACTDOC)

; Select objects to be replaced
(setq EXTSET (ssget "_I"))
(while (not (setq TOOBJ (entsel "\n+++ Select source object -> ")))
(princ "\nSource object isn't selected!")
)

; If no objects are selected as source, ask for destination selection
(if (not EXTSET)
(progn
(princ "\n+++ Select destination objects and press Enter <- ")
(setq EXTSET (ssget "_:L"))
)
)

; If no destination objects are selected, exit
(if (not EXTSET)
(princ "\nDestination objects aren't selected!")
)

; If both source and destination objects are selected, proceed with the replacement
(if (and EXTSET TOOBJ)
(progn
(initget "Yes No")
(setq ASK (getkword "\nRemove destination object [Yes/No] :"))
(setq LAYCOL (vla-get-Layers ACTDOC))
(setq EXTLST (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex EXTSET)))))
(setq VLAOBJ (vlax-ename->vla-object (car TOOBJ)))
(setq OBJLAY (vla-Item LAYCOL (vla-get-Layer VLAOBJ)))
(setq OLAYST (vla-get-Lock OBJLAY))
(setq FROMCEN (GetBoundingCenter VLAOBJ))
(setq ERRCOUNT 0 OKCOUNT 0)

; Iterate through destination objects
(foreach OBJ EXTLST
(setq TOCEN (GetBoundingCenter OBJ))
(setq SCLAY (vla-Item LAYCOL (vla-get-Layer OBJ)))

; If the destination object is not on a locked layer, proceed with the replacement
(if (/= :vlax-true (vla-get-Lock SCLAY))
(progn
(setq CURLAY (vla-get-Layer OBJ))
(vla-put-Lock OBJLAY :vlax-false)
(setq COPOBJ (vla-copy VLAOBJ))
(vla-Move COPOBJ FROMCEN TOCEN)
(_kpblc-ent-properties-copy OBJ COPOBJ)
(vla-put-Layer COPOBJ CURLAY)
(vla-put-Lock OBJLAY OLAYST)

; If user chose to remove destination object, delete it
(if (= ASK "Yes")
(vla-Delete OBJ)
)
(setq OKCOUNT (1+ OKCOUNT))
)
(setq ERRCOUNT (1+ ERRCOUNT))
)
)

; Print the results
(princ (strcat "\n" (itoa OKCOUNT) " were changed. "
(if (/= 0 ERRCOUNT)
(strcat (itoa ERRCOUNT) " were on locked layer! ")
)
)
)

; End the undo mark
(vla-EndUndoMark ACTDOC)
)
)
(princ "\nSource object isn't selected! ")
(princ)
)

[Sea-Haven]

Simple answer is Yes pick source object, pick target object, select all target objects with similar properties, say block name and layer, then replace.

The code is all there, to simplify a response what objects are we talking about ? What properties are relevant Objectname, layer, color to mention a few. It is just a case of making a repeat loop work properly with a selection set.

[mruPRQUJ]

Sorry to reply to you late as I am busy yesterday.  Please add object type, color, layer, linetype, linetype scale, line  weight and name to the lisp if it is possible, thank a lot! 🙂