AutoLISP Routine to Move All RevClouds to a Specified Layer
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I am far from an AutoLISP expert and I am trying to create a LISP that moves all of the revision clouds to an existing layer. I started with the LISP written by someone else on this page that selects all of the revision clouds and modified it only slightly:
https://www.cadtutor.net/forum/topic/50989-select-all-revclouds-in-current-drawing/
The issue for me is that the revision clouds are in paper space, so I removed the (410 . "Model") part, but now it will only select the revision clouds on the current paper space. My solution was to loop through all of the layout tabs and select the rev clouds, move them to a layer and then move onto the next layout tab (my code is below for reference). Everything is working but its running slow and I feel like this is very clunky. Is there a way to do this without actually opening each layout tab? Can I select all of the revision clouds on all of the layout tabs without opening each tab one by one?
(defun c:RevCloudLayers () ;USER ENTERS THE LAYER NAME TO MOVE ALL REVCLOUDS TO (setq layerName (getstring T "Enter the revision layer name: ")) (setq numlayouts (length (layoutlist))) ;STORES THE NUMBER OF LAYOUT TABS IN THE DRAWING ;LOOP THROUGH ALL THE LAYOUT TABS (setq i 0) ;LOOP COUNTER (while (< i numlayouts) (setvar "ctab" (nth i (layoutlist))) (c:CloudSel) (setq AllRevClouds (ssget)) (vl-cmdf "._change" AllRevClouds "" "_p" "_la" layerName "") (setq i (+ 1 i)) ) ;MOVE BACK TO COVER PAGE AND ZOOM EXTENTS (setvar "ctab" (nth 0 (layoutlist))) (command "zoom" "e") (alert "RevClouds Moved To Layer: " layerName) (princ) ) ;---------------------------------------------------------------------------------------------------- ; THIS FUNCTION WILL SELECT ALL OF THE REVISION CLOUDS ON THE CURRENT PAPER SPACE OR IN MODEL SPACE (defun c:CloudSel (/ s e i a p) (if (setq s (ssget "_X" '((0 . "LWPOLYLINE") (-4 . "/=") (42 . 0) (-4 . ">") (90 . 4)))) (repeat (setq i (sslength s)) (setq e (ssname s (setq i (1- i))) a (length (vl-remove-if-not '(lambda (u) (and (eq (car u) 42) (not (eq (cdr u) 0)))) (entget e))) p (length (vl-remove-if-not '(lambda (u) (eq (car u) 10)) (entget e))) ) (if (not (or (eq a p) (eq (1+ a) p))) (ssdel e s) ) ) ) (sssetfirst nil s) (princ) ;---------------------------------------------------------------------------------------------------- )