Reverse the properties of two objects

November 13, 2021

Hi, after several searches, I could not find a method or a lisp to swap the properties of two objects (layer, color...).

The easiest example would be between two lines or polylines, but even this search was unsuccessful.

If I have two lines to which I need to reverse the properties, I make a copy of both, and exchange the properties with the matchprop command, then delete the copies.

Is there a way to bypass the useless set of copy and delete commands?

Greetings

November 13, 2021

You could try entget the 2 objects, copy the DXF group code values for the properties you want to swap, and entmod the objects putting in the new values?

Saturday here.... CAD is off so can't do anything to check but if you have some time and google it is all out there somewhere

November 13, 2021

just cut copy pasted something together but google probably gonna find something looking like this :

(defun c:t1 ( / obi-one obi-one-proppies obi-two obi-two-proppies my-proppies)
  (setq my-proppies '(Color ConstantWidth Elevation EntityTransparency Height InsertionPoint
                      Layer Linetype LinetypeGeneration LinetypeScale Lineweight Material
                      ObliqueAngle Rotation StyleName ScaleFactor TextString TrueColor
                      Visibility XScaleFactor YScaleFactor ZScaleFactor))
  (cond
    ((not (setq obi-one (car (entsel "\nSelect first object : "))))
     (princ "\nSelection first object failed"))
    ((not (setq obi-two (car (entsel "\nSelect second object : "))))
     (princ "\nSelection second object failed"))
    (t
     (setq obi-one (vlax-ename->vla-object obi-one) obi-one-proppies (GetProppies obi-one my-proppies)
           obi-two (vlax-ename->vla-object obi-two) obi-two-proppies (GetProppies obi-two my-proppies))
     (PutProppies obi-one obi-two-proppies)
     (PutProppies obi-two obi-one-proppies)
    )
  )
  (princ)
)

(defun GetProppies (o l)
  (vl-remove 'nil (mapcar '(lambda (p)(if (vlax-property-available-p o p t)(cons p (vlax-get-property o p)))) l)))

(defun PutProppies (o l)(mapcar '(lambda (p)(if (and (vlax-property-available-p o (car p))
  (vlax-property-available-p o (car p) t))(vl-catch-all-apply 'vlax-put-property (list o (car p) (cdr p))))) l))

Edited November 13, 2021 by rlx

November 14, 2021

I have this My Match Properties, its not reversing the properties but still might be helpful.

More than 4 years old (I feel like I wrote it yesterday) time flies....

; My Match Properties - Grrr 
(defun C:MyMatchProps ( / tgassoc tgswitch *error* dcl des dch dcf tmp L SS tmpL i o )
  
  ; Toggle associator - connect toggle value (0 or 1) with symbol value (nil or T):
  (defun tgassoc ( keyorval ) (cadr (assoc keyorval '((nil "0")(T "1")("0" nil)("1" T)))) ) ; Grrr
  
  ; Toggle switcher - switch toggle's value
  (defun tgswitch ( key ) (set_tile key (cadr (assoc (get_tile key) '(("0" "1") ("1" "0")))))) ; Grrr
  
  (defun *error* ( msg )
    (and (< 0 dch) (unload_dialog dch))
    (and (eq 'FILE (type des)) (close des))
    (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
    (princ)
  ); defun *error*
  
  (cond
    ( (progn (and (setq SS (cadr (ssgetfirst))) (sssetfirst nil nil)) nil) ) ; I'm using implied SS, because I often work with SS filters
    (
      (progn
        (while (not (member dcf '(0 1)))
          (*error* nil)
          (cond
            (
              (not ; Rewrite and Reload the dialog continiously
                (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
                  (vl-every (function (lambda (x) (princ (strcat "\n" x) des))) 
                    (list
                      "MyMatchProps : dialog"
                      "{ label = \"Match Properties\";"
                      "  spacer; : column "
                      "  { : row "
                      "    { : text { label = \"Source object\"; }"
                      "      : button { key = \"sb\"; label = \">>\"; fixed_width = true; width = 2; }"
                      "    }"
                      "    : row "
                      "    { : text { label = \"Destination objects\"; }"
                      "      : button { key = \"db\"; label = \">>\"; fixed_width = true; width = 2; }"
                      "    }"
                      "  }"
                      "  : spacer { height = 1; }"
                      (if L
                        (strcat 
                          "  : column"
                          "  { children_fixed_width = true; children_alignment = left;"
                          "    : text { label = \"Properties To Match\"; }  spacer;"
                          (apply 'strcat (mapcar (function (lambda (x) (strcat ": toggle { label = \"" (car x) "\"; key = \"" (car x) "\"; value = 1; }"))) L))
                          "    spacer;"
                          "    : button { label = \"Switch Toggles\"; key = \"Switch\"; mnemonic = \"t\"; }"
                          "    spacer;"
                          "  }"
                        ); strcat
                        "  : text { label = \"Source object not specified!\"; alignment = centered; }"
                      ); if L
                      "  : spacer { height = 1; }"
                      "  ok_cancel; : text { key = \"error\"; }"
                      "}"
                    ); list
                  ); vl-every
                  (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
                ); and
              ); not
              (princ "\nUnable to write or load the DCL file.") (setq dcf 0)
            )
            ( (not (new_dialog "MyMatchProps" dch)) (princ "\nUnable to display the dialog") (setq dcf 0) )
            (T 
              (if tmpL (mapcar (function (lambda (x) (set_tile (car x) (cdr x)))) tmpL)) ; remember (restore) chosen toggles between sessions.
              (vl-every (function (lambda (x) (action_tile (car x) (strcat "(done_dialog " (itoa (cadr x)) ")")))) '(("sb" 2) ("db" 3))) ; button actions
              (action_tile "Switch"
                (vl-prin1-to-string 
                  '(progn
                    (mapcar (function (lambda (x) (tgswitch x))) (mapcar 'car L))
                    (setq tmpL (mapcar (function (lambda (x) (cons x (get_tile x)))) (mapcar 'car L)))
                  ); progn
                ); vl-prin1-to-string
              ); action_tile
              (if L
                (vl-every ; toggle actions 
                  (function 
                    (lambda (x) 
                      (action_tile (car x) 
                        (vl-prin1-to-string 
                          '(cond 
                            ( (assoc $key tmpL) (setq tmpL (subst (cons $key $value) (assoc $key tmpL) tmpL)) )
                            ( (setq tmpL (cons (cons $key $value) tmpL)) )
                          ); cond
                        ); vl-prin1-to-string
                      ); action_tile
                    ); lambda
                  ); function
                  L
                ); vl-every
              ); if L
              (action_tile "accept" 
                (vl-prin1-to-string 
                  '(cond 
                    ( (not L) (set_tile "error" "Check the above message - Grrr.") ) 
                    ( (not SS) (set_tile "error" "Destination objects not specified!") ) 
                    ( (setq L (mapcar (function (lambda (x) (append x (list (get_tile (car x)))))) L)) ; end result of L
                      (done_dialog 1)
                    ) 
                  ); cond
                ); vl-prin1-to-string
              ); action_tile
              (setq dcf (start_dialog))
            ); T
          ); cond
          (cond 
            ( (= 2 dcf) 
              (and  
                (setq tmp
                  (
                    (lambda (x / p)
                      (setvar 'errno 0) 
                      (while (/= 52 (getvar 'errno)) (setq p (car (entsel "\nSelect Source Object <exit>: ")))
                        (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again!") (setvar 'errno 0) )
                          (p (setq p (vlax-ename->vla-object p)) (setvar 'errno 52) )
                        ); cond
                      ); while
                      p
                    ); lambda
                    nil
                  )
                ); setq tmp
                (setq L ; I care about only this list here
                  (apply 'append
                    (mapcar (function (lambda (x) (if (vlax-property-available-p tmp x) (list (list x (vlax-get tmp x))))))
                      '("Color" "Layer" "LineType" "LinetypeScale" "Lineweight"
                        "EntityTransparency" "Material" "Rotation" "TextString" "StyleName" "Width" "Height"
                        "AttachmentPoint" "BackgroundFill" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle"
                        "XEffectiveScaleFactor" "XScaleFactor" "YEffectiveScaleFactor" "YScaleFactor" "ZEffectiveScaleFactor" "ZScaleFactor"
                      ); list
                    ); mapcar
                  ); apply 'append
                ); setq L
              ); and
            ); (= 2 dcf)
            ( (= 3 dcf) (and (princ "\nSelect Destination Objects: ") (setq tmp (ssget "_:L")) (setq SS tmp) ) ); (= 3 dcf)
          ); cond
        ); while
        (/= 1 dcf) 
      ); progn
      (princ "\nUser cancelled the dialog.")
    )
    ( (and L SS) 
      (setq L (vl-remove-if (function (lambda (x) (not (tgassoc (caddr x))))) L))
      (repeat (setq i (sslength SS))
        (and (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) (vlax-write-enabled-p o)
          (mapcar 
            (function 
              (lambda (x) 
                (and (vlax-property-available-p o (car x)) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x))))
              ); lambda 
            ); function
            L
          ); mapcar
        ); and
      ); repeat
      ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) L))) ; check
      ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) tmpL))) ; check 
    ); T
  ); cond
  (*error* nil) (princ) 
); defun

November 14, 2021

Nice one Grrr , glad to see you're still into lisping

November 14, 2021

Something I do a lot in my workplace too. I made subfunctions for the general properties only though, so it's not exactly as advanced as matchprop:

(defun c:swapprop ( / ent1 ent2 getobject)
    (defun getobject (msg / ex)
        (while
            (progn
                (setvar "errno" 0)
                (initget "Exit")
                (setq ex (entsel msg))
                (cond
                    (   (= (getvar "errno") 7) (princ "\nNothing selected."))
                    (   (member ex '("Exit" nil)) nil)
                    (   (not (setq ex (car ex))))
                )
            )
        )
        ex
    )
    (and
        (setq ent1 (getobject "\nSelect first entity <exit>: "))
        (setq ent2 (getobject "\nSelect second entity <exit>: "))
        (mapcar 'JH:ModifyProperty (list ent1 ent2) (mapcar 'JH:EntityProperties (list ent2 ent1)))
    )
    (princ)
)

;; JH:EntityProperties --> Jonathan Handojo
;; Returns the general properties of an entity.
;; ent [ename] - entity

(defun JH:EntityProperties (ent / get)
    (setq get (entget ent))
    (mapcar
        '(lambda (a)
                (cond ((assoc (car a) get)) (a))
        )
        '(
            (62 . 256)
            (8)
            (6 . "ByLayer")
            (48 . 1.0)
            (370 . -1)
            (39 . 0.0)
            (440 . 0)
        )
    )
)

;; JH:ModifyProperty --> Jonathan Handojo
;; Modifies the properties of an entity from an DXF association list
;; 
;; ent [ename] - entity
;; lst [list] - an association list of properties to modify

(defun JH:ModifyProperty (ent lst)
    (entmod
        (append
            (mapcar
                '(lambda (a / asc)
                    (if (setq asc (assoc (car a) lst))
                        (progn (setq lst (vl-remove asc lst)) asc)
                        a
                    )
                )
                (entget ent)
            )
            lst
        )
    )
)

Edited November 15, 2021 by Jonathan Handojo

November 14, 2021

14 hours ago, Grrr said:

I have this My Match Properties, its not reversing the properties but still might be helpful.

More than 4 years old (I feel like I wrote it yesterday) time flies....


; My Match Properties - Grrr 
(defun C:MyMatchProps ( / tgassoc tgswitch *error* dcl des dch dcf tmp L SS tmpL i o )
  
  ; Toggle associator - connect toggle value (0 or 1) with symbol value (nil or T):
  (defun tgassoc ( keyorval ) (cadr (assoc keyorval '((nil "0")(T "1")("0" nil)("1" T)))) ) ; Grrr
  
  ; Toggle switcher - switch toggle's value
  (defun tgswitch ( key ) (set_tile key (cadr (assoc (get_tile key) '(("0" "1") ("1" "0")))))) ; Grrr
  
  (defun *error* ( msg )
    (and (< 0 dch) (unload_dialog dch))
    (and (eq 'FILE (type des)) (close des))
    (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
    (princ)
  ); defun *error*
  
  (cond
    ( (progn (and (setq SS (cadr (ssgetfirst))) (sssetfirst nil nil)) nil) ) ; I'm using implied SS, because I often work with SS filters
    (
      (progn
        (while (not (member dcf '(0 1)))
          (*error* nil)
          (cond
            (
              (not ; Rewrite and Reload the dialog continiously
                (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
                  (vl-every (function (lambda (x) (princ (strcat "\n" x) des))) 
                    (list
                      "MyMatchProps : dialog"
                      "{ label = \"Match Properties\";"
                      "  spacer; : column "
                      "  { : row "
                      "    { : text { label = \"Source object\"; }"
                      "      : button { key = \"sb\"; label = \">>\"; fixed_width = true; width = 2; }"
                      "    }"
                      "    : row "
                      "    { : text { label = \"Destination objects\"; }"
                      "      : button { key = \"db\"; label = \">>\"; fixed_width = true; width = 2; }"
                      "    }"
                      "  }"
                      "  : spacer { height = 1; }"
                      (if L
                        (strcat 
                          "  : column"
                          "  { children_fixed_width = true; children_alignment = left;"
                          "    : text { label = \"Properties To Match\"; }  spacer;"
                          (apply 'strcat (mapcar (function (lambda (x) (strcat ": toggle { label = \"" (car x) "\"; key = \"" (car x) "\"; value = 1; }"))) L))
                          "    spacer;"
                          "    : button { label = \"Switch Toggles\"; key = \"Switch\"; mnemonic = \"t\"; }"
                          "    spacer;"
                          "  }"
                        ); strcat
                        "  : text { label = \"Source object not specified!\"; alignment = centered; }"
                      ); if L
                      "  : spacer { height = 1; }"
                      "  ok_cancel; : text { key = \"error\"; }"
                      "}"
                    ); list
                  ); vl-every
                  (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
                ); and
              ); not
              (princ "\nUnable to write or load the DCL file.") (setq dcf 0)
            )
            ( (not (new_dialog "MyMatchProps" dch)) (princ "\nUnable to display the dialog") (setq dcf 0) )
            (T 
              (if tmpL (mapcar (function (lambda (x) (set_tile (car x) (cdr x)))) tmpL)) ; remember (restore) chosen toggles between sessions.
              (vl-every (function (lambda (x) (action_tile (car x) (strcat "(done_dialog " (itoa (cadr x)) ")")))) '(("sb" 2) ("db" 3))) ; button actions
              (action_tile "Switch"
                (vl-prin1-to-string 
                  '(progn
                    (mapcar (function (lambda (x) (tgswitch x))) (mapcar 'car L))
                    (setq tmpL (mapcar (function (lambda (x) (cons x (get_tile x)))) (mapcar 'car L)))
                  ); progn
                ); vl-prin1-to-string
              ); action_tile
              (if L
                (vl-every ; toggle actions 
                  (function 
                    (lambda (x) 
                      (action_tile (car x) 
                        (vl-prin1-to-string 
                          '(cond 
                            ( (assoc $key tmpL) (setq tmpL (subst (cons $key $value) (assoc $key tmpL) tmpL)) )
                            ( (setq tmpL (cons (cons $key $value) tmpL)) )
                          ); cond
                        ); vl-prin1-to-string
                      ); action_tile
                    ); lambda
                  ); function
                  L
                ); vl-every
              ); if L
              (action_tile "accept" 
                (vl-prin1-to-string 
                  '(cond 
                    ( (not L) (set_tile "error" "Check the above message - Grrr.") ) 
                    ( (not SS) (set_tile "error" "Destination objects not specified!") ) 
                    ( (setq L (mapcar (function (lambda (x) (append x (list (get_tile (car x)))))) L)) ; end result of L
                      (done_dialog 1)
                    ) 
                  ); cond
                ); vl-prin1-to-string
              ); action_tile
              (setq dcf (start_dialog))
            ); T
          ); cond
          (cond 
            ( (= 2 dcf) 
              (and  
                (setq tmp
                  (
                    (lambda (x / p)
                      (setvar 'errno 0) 
                      (while (/= 52 (getvar 'errno)) (setq p (car (entsel "\nSelect Source Object <exit>: ")))
                        (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again!") (setvar 'errno 0) )
                          (p (setq p (vlax-ename->vla-object p)) (setvar 'errno 52) )
                        ); cond
                      ); while
                      p
                    ); lambda
                    nil
                  )
                ); setq tmp
                (setq L ; I care about only this list here
                  (apply 'append
                    (mapcar (function (lambda (x) (if (vlax-property-available-p tmp x) (list (list x (vlax-get tmp x))))))
                      '("Color" "Layer" "LineType" "LinetypeScale" "Lineweight"
                        "EntityTransparency" "Material" "Rotation" "TextString" "StyleName" "Width" "Height"
                        "AttachmentPoint" "BackgroundFill" "LineSpacingDistance" "LineSpacingFactor" "LineSpacingStyle"
                        "XEffectiveScaleFactor" "XScaleFactor" "YEffectiveScaleFactor" "YScaleFactor" "ZEffectiveScaleFactor" "ZScaleFactor"
                      ); list
                    ); mapcar
                  ); apply 'append
                ); setq L
              ); and
            ); (= 2 dcf)
            ( (= 3 dcf) (and (princ "\nSelect Destination Objects: ") (setq tmp (ssget "_:L")) (setq SS tmp) ) ); (= 3 dcf)
          ); cond
        ); while
        (/= 1 dcf) 
      ); progn
      (princ "\nUser cancelled the dialog.")
    )
    ( (and L SS) 
      (setq L (vl-remove-if (function (lambda (x) (not (tgassoc (caddr x))))) L))
      (repeat (setq i (sslength SS))
        (and (setq o (vlax-ename->vla-object (ssname SS (setq i (1- i))))) (vlax-write-enabled-p o)
          (mapcar 
            (function 
              (lambda (x) 
                (and (vlax-property-available-p o (car x)) (vl-catch-all-apply 'vlax-put (list o (car x) (cadr x))))
              ); lambda 
            ); function
            L
          ); mapcar
        ); and
      ); repeat
      ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) L))) ; check
      ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) tmpL))) ; check 
    ); T
  ); cond
  (*error* nil) (princ) 
); defun

Wow, that's an amazing work, and certainly better than my crappy version . Well done. Must have taken hours of coding and debugging.

November 15, 2021

Another for fun this is the get properties part. Then do a put properties. Idea was its a library function load when required could add more properties like color and Linetypes.

; properties use as a library function
; By Alan H july 2020

(defun cords (obj / co-ords xy )
(setq coordsxy '())
(setq co-ords (vlax-get obj 'Coordinates))
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth (+ I 1) co-ords)(nth I co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
)
)


(defun AH:chkcwccw (obj / lst newarea)
(setq lst (CORDS obj))
(setq newarea
(/ (apply (function +)
            (mapcar (function (lambda (x y)
                                (- (* (car x) (cadr y)) (* (car y) (cadr x)))))
                    (cons (last lst) lst)
                    l)) 
2.)
)
(if (< newarea  0)
(setq cw "F")
(setq cw "T")
)
)

; Can use reverse in Autocad - pedit reverse in Bricscad.

(defun plprops (obj txt / lst)
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vla-get-layer obj)))
((= (strcase val) "AREA")(setq area (vla-get-area obj)))
((= (strcase val) "START")(setq start (vlax-curve-getstartpoint obj)))
((= (strcase val) "END" (strcase txt))(setq end (vlax-curve-getendpoint obj)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Length)))
((= (strcase val) "CW" (strcase txt))(AH:chkcwccw obj))
((= (strcase val) "CORDS" (strcase txt))(CORDS obj))
)
)
)

(defun lineprops (obj lst / )
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "START")(setq start (vlax-get obj 'startpoint)))
((= (strcase val) "END" (strcase txt))(setq end (vlax-get obj 'endpoint)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Length)))
)
)
)

(defun circprops (obj lst / )
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Circumference)))
((= (strcase val) "RAD" (strcase txt))(setq rad (vla-get-radius obj)))
((= (strcase val) "CEN" (strcase txt))(setq cen (vlax-get obj 'Center)))
((= (strcase val) "AREA" (strcase txt))(setq end (vlax-get obj 'AREA)))
)
)
)

(defun arcprops (obj txtlst)
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'length)))
((= (strcase val) "RAD" (strcase txt))(setq rad (vla-get-radius obj)))
((= (strcase val) "CEN" (strcase txt))(setq cen (vlax-get obj 'Center)))
((= (strcase val) "START" (strcase txt))(setq area (vlax-get obj 'startpoint)))
((= (strcase val) "END" (strcase txt))(setq area (vlax-get obj 'endpoint)))
((= (strcase val) "AREA" (strcase txt))(setq end (vlax-get obj 'AREA)))
)
)
)

; starts here
(setq ent (vlax-ename->vla-object (car (entsel "Pick Object "))))
; do a check for object type then use defun
; pick an example below


; many examples copy to command line for testing mix and match 
; (plprops ent '("LAY"))(princ lay)
; (plprops ent '("END"))(princ end)
; (plprops ent '("START"))(princ start)
; (plprops ent '("END" "START"))(princ end)(princ start)
; (plprops ent '("AREA" "LAY" "END" "START"))(princ area)(princ lay)(princ end)(princ start)
; (plprops ent '("START" "AREA" "LAY" "CW"))(princ start)(princ area)(princ cw)
; (plprops ent '("start" "END" "CORDS" "cw"))(princ start)(princ end)(princ coordsxy)(princ cw)
; (plprops ent '("CW"))(princ cw)
; (plprops ent '("AREA"))(princ area)
; (plprops ent '("CORDS"))(princ coordsxy)
; (lineprops ent "len"))(princ len)
; (lineprops ent '("len" "lay"))(princ len)(princ lay)
; (lineprops ent '("lay" "end" "start" "len"))(princ len)(princ lay)(princ start)(princ end)
; (circprops ent '("lay" "rad" "area" "cen"))(princ lay)(princ rad)(princ area)(princ cen)
; (circprops ent '("lay" "rad"))
; (arcprops ent '("lay" "rad"))

November 15, 2021

I'm not sure if Johathan's version will work as intended because if you mod ent1 and then mod ent2 ... (setq a 1) (setq b 2) -> (setq a b) (setq b a) -> a = 2 , b = 2

If OP has to do a lot of swapping maybe this one is more 'fluid'

(defun c:t2 ( / a b pa pl _gp _pp) (vl-load-com)
  (defun _gp (o l)
    (vl-remove 'nil (mapcar '(lambda (p)(if (vlax-property-available-p o p t)(cons p (vlax-get-property o p)))) l)))
  (defun _pp (o l)(mapcar '(lambda (p)(if (and (vlax-property-available-p o (car p))
    (vlax-property-available-p o (car p) t))(vl-catch-all-apply 'vlax-put-property (list o (car p) (cdr p))))) l))
  (setq pl '(Color ConstantWidth Elevation EntityTransparency Height InsertionPoint Layer Linetype LinetypeGeneration LinetypeScale Lineweight
               Material ObliqueAngle Rotation StyleName ScaleFactor TextString TrueColor Visibility XScaleFactor YScaleFactor ZScaleFactor))
  (while (and (princ "\nSelect first object : ")(setq a (ssget ":S"))(setq a (vlax-ename->vla-object (ssname a 0)))
              (princ "\nSelect second object : ")(setq b (ssget ":S"))(setq b (vlax-ename->vla-object (ssname b 0))))
    (setq pa (_gp a pl))(_pp a (_gp b pl))(_pp b pa)) (princ))

November 15, 2021

1 hour ago, rlx said:

I'm not sure if Johathan's version will work as intended because if you mod ent1 and then mod ent2 ... (setq a 1) (setq b 2) -> (setq a b) (setq b a) -> a = 2 , b = 2

If OP has to do a lot of swapping maybe this one is more 'fluid'






(defun c:t2 ( / a b pa pl _gp _pp) (vl-load-com)
  (defun _gp (o l)
    (vl-remove 'nil (mapcar '(lambda (p)(if (vlax-property-available-p o p t)(cons p (vlax-get-property o p)))) l)))
  (defun _pp (o l)(mapcar '(lambda (p)(if (and (vlax-property-available-p o (car p))
    (vlax-property-available-p o (car p) t))(vl-catch-all-apply 'vlax-put-property (list o (car p) (cdr p))))) l))
  (setq pl '(Color ConstantWidth Elevation EntityTransparency Height InsertionPoint Layer Linetype LinetypeGeneration LinetypeScale Lineweight
               Material ObliqueAngle Rotation StyleName ScaleFactor TextString TrueColor Visibility XScaleFactor YScaleFactor ZScaleFactor))
  (while (and (princ "\nSelect first object : ")(setq a (ssget ":S"))(setq a (vlax-ename->vla-object (ssname a 0)))
              (princ "\nSelect second object : ")(setq b (ssget ":S"))(setq b (vlax-ename->vla-object (ssname b 0))))
    (setq pa (_gp a pl))(_pp a (_gp b pl))(_pp b pa)) (princ))

Well, if you don't try, you won't know.

I had this questioned in my head a couple times too, then our legend taught me something valuable that I kept on exploiting. Mapcar would evaluate any lists first prior to executing the lambda. Therefore, mapcar 'EntityProperties will be fully executed first before 'ModifyProperty. And then later I found out that this is also the case for other similar functions such as vl-some and vl-every. Reference is in here while I was toying around with Ish: https://www.cadtutor.net/forum/topic/64451-request-lisp-command-that-can-quick-swap-text-between-two-objects/page/2/?tab=comments#comment-580485

Plus, if we're talking MATCHPROP, does rotation, insertion point, and scale fall under the category? You wouldn't select two blocks and expect them to be rotated, swap positions, or scaled up, right? Or select two texts and expect their texts to be modified... I tested your t1 a few hours ago between two texts of different rotations and they both rotate. I haven't tried t2 though.

Edited November 15, 2021 by Jonathan Handojo

November 15, 2021

To be honest I just looked at (p)linewith actually but that's easy enough to fix / add.

I added a flog of (easy to read) props to a list so OP can decide which ones are important and which ones are'nt. You could of cource add a dialog with toggles for all the props you want to include but before you know it you are re-inventing the (matchproperty) wheel. Most of my app's are 1% core code and 99% dialog and error checking.

November 15, 2021

1 hour ago, rlx said:

To be honest I just looked at (p)linewith actually but that's easy enough to fix / add.

I added a flog of (easy to read) props to a list so OP can decide which ones are important and which ones are'nt. You could of cource add a dialog with toggles for all the props you want to include but before you know it you are re-inventing the (matchproperty) wheel. Most of my app's are 1% core code and 99% dialog and error checking.

Certainly your code would definitely be the more practical one, given that mine would only match the general properties of any entity and nothing else (which was always my intent to begin with in the first place). At least in my workplace, that's more than enough, but it was also a challenge for me to try and avoid using vlax approach if possible because originally I created those subfunctions to perform the AutoCAD MATCHPROP command in reverse... by first selecting the destination objects (which could potentially be thousands of objects through select similar or some dirty ssget methods), and then the source. So using vlax approach would take a bit of time, and I thought just the general properties was enough for me. I just thought I'd share a bit of how I do stuff as well in here, but of course your code works just as great... certainly better.

November 15, 2021

nah , its not a race which one is better , many roads lead to Rome , its just finding what works best for you (or in this case for our silent OP ) because only (p)lines are mentionend here (for now) and also finding the balance between investment and return in turns of coding-time and yield. Bigal usually has a good instinct for the balance between sense and nonsense where I sometimes can go over the top in the hope one day I get my investment (in time) back. I have created some great appies in the past for my co-workers that nobody uses because they say , great but too complicated , but now you can do my work in half the time so now I code most of the time for my 3 best friends , me , myself & I

November 15, 2021

Thank you all! All the lisp are great! for what I have to do, those of Jonathan Handojo and RLX's are the most immediate, but surely I will also use that of Grrr!

Greetings

November 16, 2021

On 11/14/2021 at 11:59 PM, Jonathan Handojo said:

Wow, that's an amazing work, and certainly better than my crappy version . Well done. Must have taken hours of coding and debugging.

I actually don't remember the effort I put in it, but it wasn't that much... since I was doing a bit more complex things aswell back then, like this recursive f&*k.

On 11/14/2021 at 11:48 AM, rlx said:

Nice one Grrr , glad to see you're still into lisping

Its nothing new, I think I was inspired back then by your Rlx "tokkie lunch break" idea for rewriting the DCL dialog on-the-fly, so I wrote several routines with this concept.

Actually I haven't been LISP-ing for a year or so (just because I'm out of ideas what to code), so I've switched on to other programming languages,

which support different 3rd party apps that I use (like Photoshop and 3ds Max) recently.

But I still like to browse through cadtutor forum and participate whenever I can (like in the good old days).

On 11/15/2021 at 11:58 PM, itacad said:

but surely I will also use that of Grrr!

Thanks, funny is that I actually don't find my code that much useful for me as I thought it would be, but remains somewhat valuable for the LISP learners.

Sign In

Reverse the properties of two objects

Recommended Posts

itacad

Steven P

rlx

Grrr

rlx

Jonathan Handojo

Jonathan Handojo

BIGAL

rlx

Jonathan Handojo

rlx

Jonathan Handojo

rlx

itacad

Grrr

Join the conversation

Tutorials

Forums

Activity