MATCH_DUCT_PIPE_SYSTEM_v2_02.................free

Command: MAS


Function works in style of standard MATCHPROP command

but matches also other special MEP objects properties like SystemName, Insulation, LiningThickness and so on, what  MATCHPROP command cannot do.

 

Code:

;;; ================================================
;;;        MATCH_DUCT_PIPE_SYSTEM_v2_02.LSP     
;;;
;;;        Written by Andrzej Kalinowski,     www.autolisps.blogspot.com
;;;        v1.00 - 07.07.2018 - first release
;;;        v2.02 - 23.04.2022 - corrected quiting the "Objects selection" loop
;;;
;;;        Command: MAS
;;;            Function works in style of standard MATCHPROP command but matches also other special MEP objects properties
;;;            like SystemName, Insulation, LiningThickness and so on, what  MATCHPROP command cannot do.
;;;
;;; ================================================
(vl-load-com)
(defun c:MAS (/ obj1 sset2 type1 entlist1 i1 curobj1 sysname1 insulTh layer1 color1 Material1 LockSize1 LininTh LineW1 LTScale1 LT1 EntTransp1 gr1)
    ;-----------------------------------------
    ;selection of the first mep obj
    ;-----------------------------------------
    (setq obj1 nil)
    (setq gr1 1)
    (while (/= gr1 52)
        (setvar "ERRNO" 0);reset ERRNO to 0
        (prompt "\nSelect first MEP duct/pipe/fitting ")
        (setq obj1 (ssget "_+.:S") )
        (setq gr1 (getvar "ERRNO") )
        (if (= (getvar "ERRNO") 52) (exit))
        (if (= obj1 nil)
            (princ "\nWrong object");then
            (if (> (sslength obj1) 1);else-chekcs if only 1 obj is selected       
                (progn     (setq obj1 nil)    (princ "\nSelect only one object")    (princ) )
                (progn ;else
                    (setq obj1 (ssname obj1 0) 
                        entlist1 (entget obj1)
                        type1 (cdr (assoc 0 entlist1) )
                    );setq
                    (if (member type1 (list "AECB_PIPEFITTING" "AECB_DUCTFITTING" "AECB_PIPE" "AECB_DUCTFLEX" "AECB_DUCT") )
                        (setq gr1 52)
                        (progn     (setq obj1 nil)    (prompt "\nWrong object") )
                    ); if 
                );progn else
            ); if
        ); if
    ); while
	
   (setq
        obj1 (vlax-ename->vla-object obj1);0
        sysname1 (vlax-get obj1 'SystemName);1
        layer1 (vlax-get obj1 'Layer);2
        insulTh (vlax-get obj1 'InsulationThickness);3
        color1 (vlax-get obj1 'TrueColor);4
        Material1 (vlax-get obj1 'Material);5
        LockSize1 (vlax-get obj1 'LockSize);6
        LininTh (vlax-get obj1 'LiningThickness);7
        LTScale1 (vlax-get obj1 'LinetypeScale);8
        LT1 (vlax-get obj1 'Linetype);9
        EntTransp1 (vlax-get obj1 'EntityTransparency);10
        LineW1 (vlax-get obj1 'Lineweight);11
    );setq
    ;-----------------------------------------
    ;selection of the second mep obj
    ;-----------------------------------------
    (setq gr1 1)
    (while (/= gr1 52)
        (setvar "ERRNO" 0);reset ERRNO to 0
        (prompt "\nSelect second MEP duct/pipe/fitting ")
        (setq sset2 (ssget "_:S" ) )
        (setq gr1 (getvar "ERRNO") )
        (if (= (getvar "ERRNO") 52) (exit))
        (if (= sset2 nil)
            (princ "\nWrong object");then
            (progn ;then
                (repeat (setq i1 (sslength sset2) );else
                    (setq
                        curobj1 (ssname sset2 (setq i1 (1- i1) ) )
                        entlist1 (entget curobj1)
                        type1 (cdr (assoc 0 entlist1)  )
                        LW1 (cdr (assoc 370 entlist1)  )
                        curobj1 (vlax-ename->vla-object curobj1)
                    );setq
                    (if (not (or (= type1 "AECB_PIPEFITTING") (= type1 "AECB_DUCTFITTING") (= type1 "AECB_PIPE") (= type1 "AECB_DUCT") ) )
                        (ssdel (vlax-vla-object->ename curobj1) sset2);then
                    );end if
                );repeat
                ;-----------------------------------------
                ;matching insulation thickness property
                ;-----------------------------------------
                (repeat (setq i1 (sslength sset2) )
                    (setq    curobj1 (ssname sset2 (setq i1 (1- i1) ) ) )
                    (setq    curobj1 (vlax-ename->vla-object curobj1) )

                     (vlax-put curobj1 'SystemName sysname1);1
                     (vlax-put curobj1 'Layer layer1);2
                     (vlax-put curobj1 'InsulationThickness insulTh);3
                     (vlax-put curobj1 'TrueColor color1);4
                     (vlax-put curobj1 'Material Material1);5
                     (vlax-put curobj1 'LockSize LockSize1);6
                     (vlax-put curobj1 'LiningThickness LininTh);7
                     (vlax-put curobj1 'LinetypeScale LTScale1);8
                     (vlax-put curobj1 'Linetype LT1);9
                     (vlax-put curobj1 'EntityTransparency EntTransp1);10
                     (vlax-put curobj1 'Lineweight LineW1);11
                );repeat	
            );progn	   
        );end if
    );while
    (princ)
);end defun

Example:

 

Version history:
v1.00 - 07.07.2018 - first release
v2.02 - 23.04.2022 - corrected quiting the "Objects selection" loop


File format:
.FAS


Compatibility:
-All Autocad MEP
versions


Download file: MATCH_DUCT_PIPE_SYSTEM_v2_02.FAS

No comments:

Post a Comment