REVCLOUDS_v2_00.............................................free

Command: REVC

This function creates rectangular revision cloud by drawing a rectangle and transforing it to revisioncloud.

Command: REVCS

This function transforms all selected polylines to the revision clouds

 

Code:

;;; ===============================================
;;;        REVCLOUDS_v2_00.LSP   
;;;
;;;        Written by Andrzej Kalinowski,     www.autolisps.blogspot.com
;;;        v1.01 - 11.07.2016
;;;        v2.00 - 22.05.2022 - added end-undo mark, corrected retriving objects layer and color
;;;
;;;        Command: REVC - makes rectangular revision cloud
;;;        Command: REVCS - transforms all selected objects to the revision clouds - supported object types: LINE,LWPOLYLINE,POLYLINE,SPLINE,CIRCLE
;;;
;;; ================================================
(defun c:REVC (/ obj1 doc1 )
    (setq doc1 (vla-get-activedocument (vlax-get-acad-object)))
    (vla-startundomark doc1)
    (if (or
            (= (vla-get-layeron (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (getvar "CLAYER") ) ) :vlax-false)
            (= (vla-get-lock (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object) ) ) (getvar "CLAYER") ) ) :vlax-true)
        );or
        (progn (alert "Current layer is off or locked.") (exit) )
    );if
    (command "_rectang" pause pause)
    (command "_revcloud" "_object" (entlast) "")
    (vla-endundomark doc1)
    (setq doc1 nil)
    (princ)
);defun

;;; ================================================
(defun c:REVCS (/ sset1 curobj1 i1 lock1 lay1 col430 col420 col62 entlist1)
    (setq doc1 (vla-get-activedocument (vlax-get-acad-object)))
    (vla-startundomark doc1)
    (prompt "Select objects you want to convert to revclouds  ")
    (setq sset1 (ssget  '( (0 . "LINE,LWPOLYLINE,POLYLINE,SPLINE,CIRCLE") ) ) ) 
    (repeat (setq i1 (sslength sset1) )
        (setq curobj1 (ssname sset1 (setq i1 (1- i1) ) ) )
        ;-----------------------------------------
        ;saving layer and color
        ;-----------------------------------------
        (setq lay1 (vla-get-layer (vlax-ename->vla-object curobj1)))
        (cond
            ( (assoc 430 (entget curobj1))                   (setq col430 (assoc 430 (entget curobj1) ) col420 (vla-get-truecolor (vlax-ename->vla-object curobj1 ) ))    )
            ( (and (assoc 420 (entget curobj1)) (= (assoc 430 (entget curobj1)) nil) )    (setq col420 (vla-get-truecolor (vlax-ename->vla-object curobj1 ) ))    )
            ( T (setq col62 (vla-get-color (vlax-ename->vla-object curobj1) ) ) )
        );cond    
        ;-----------------------------------------
        (if (=(vla-get-lock (vla-item(vla-get-layers (vla-get-activedocument (vlax-get-acad-object) )) lay1)):vlax-false )
            (progn
                (command "_revcloud" "_object" curobj1 "") 
                ;-----------------------------------------
                ;matching layer and color
                ;-----------------------------------------
                (vla-put-layer (vlax-ename->vla-object (entlast) ) lay1)
                (setq entlist1 (entget (entlast)))
                (cond
                    ( col430
                        (vla-put-truecolor (vlax-ename->vla-object (entlast) ) col420)
                        (setq entlist1 (append entlist1 (list col430)));setq
                        (entmod entlist1)
                    )
                    ( (and (= col430 nil ) col420 )    (vla-put-truecolor (vlax-ename->vla-object (entlast) ) col420) )
                    ( T (vla-put-color (vlax-ename->vla-object (entlast) ) col62) )
                );cond    
                ;-----------------------------------------
            );progn
            (setq lock1 1)
        );if
    ); repeat
    (vla-regen (vla-get-activedocument (vlax-get-acad-object) ) acallviewports)
    (if (= lock1  1) (alert "Some objects were on a locked layer and have not been converted to revclouds.") )
    (vla-endundomark doc1)
    (setq doc1 nil)
    (princ)
);defun
;;; ================================================

Example:

Download file: REVCLOUDS_v2_00.FAS