MATCH_LAYER_v3_01........................................free

Command: MAL

Function works in style of standard  MATCHPROP command but matches only Layer property leaving other properties unchanged.


Code:
;;; ================================================
;;;        MATCH_LAYER_v3_01.LSP     
;;;
;;;        Written by Andrzej Kalinowski,     www.autolisps.blogspot.com
;;;        v3.00 - 29.10.2016
;;;		v3.01 - 23.04.2022 - corrected quiting the "Objects selection" loop
;;;
;;;        Command: MAL - Function works in style of standard  MATCHPROP command
;;;                    but matches only Layer property leaving other properties unchanged.
;;; ================================================
(defun C:MAL (/ obj1 sset2 lyr1 curobj1 i1 gr1)
    ;-----------------------------------------
    ;object selection
    ;-----------------------------------------
    (setq obj1 nil)
    (setq gr1 1)
    (while (/= gr1 52)
        (setvar "ERRNO" 0);reset ERRNO to 0
        (prompt "\nSelect source object: ---------------- ")
        (setq obj1 (ssget "_:S+.") )
        (setq gr1 (getvar "ERRNO") )
        (if (= (getvar "ERRNO") 52) (exit))
        (if (= obj1 nil)
            (princ "\nwrong object")
            (if (> (sslength obj1) 1)
                (progn
                    (princ "\nselect only one object")(princ)
                    (setq obj1 nil)
                );progn
                (setq gr1 52)
            );end if
        );end if
    );end while
    (setq obj1 (ssname obj1 0))
    ;-----------------------------------------
    ;reading of layername
    ;-----------------------------------------
    (setq lyr1 (vlax-get (vlax-ename->vla-object obj1) 'Layer) )
    ;-----------------------------------------
    ;selection of the second mep obj
    ;-----------------------------------------
    (setq gr1 1)
    (while (/= gr1 52)
        (setvar "ERRNO" 0);reset ERRNO to 0
        (prompt "\nSelect target objects: ---------------- ")
        (setq sset2 (ssget "_:S" ) )
        (setq gr1 (getvar "ERRNO") )
        (if (= (getvar "ERRNO") 52) (exit))
        (if (= sset2 nil)
            (princ "\nWrong object");then
            ;-----------------------------------------
            ;matching layer property
            ;-----------------------------------------
    		(repeat (setq i1 (sslength sset2) );else
                 (setq
                      curobj1 (ssname sset2 (setq i1 (1- i1) ) )
                      curobj1 (vlax-ename->vla-object curobj1)
                 );setq          
                (vlax-put curobj1 'Layer lyr1)
    		);repeat
        );end if
    );while
);defun


Example:



Version history:
v1.00 - 29.10.2016 - first release
v3.00 - 29.10.2016 - misc updates
v3.01 - 23.04.2022 - corrected quiting the "Objects selection" loop

 File format:
.FAS


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.
Command aliases used in video-example: CF for COPYFURTHER.

Download file: MATCH_LAYER_v3_01.FAS

No comments:

Post a Comment