Topic: Select revclouds

[Joe Burke]

I hacked this today because I have a bunch of drawings where the old revclouds need to be deleted before adding new ones. There's many existing clouds. Trying to pick them out visually is error prone and a waste of time.

It works, but I wonder if there's an easier way codewise, like a filtered selection set? I'm not up on the -4 stuff.

Thanks for any suggestions.

Code: [Select]

;; Select revclouds
;; Distinguish revclouds from other lwplines by checking every
;; vertex has a 42 DXF code other than zero.
(defun c:SRC ( / i ss ssrc e elst)
  (setq i 0 ssrc (ssadd))
  (if (setq ss (ssget "x" '((0 . "LWPOLYLINE") (410 . "Model"))))
    (repeat (sslength ss)
      (setq e (ssname ss i))
      (setq elst (vl-remove-if-not '(lambda (x) (= 42 (car x))) (entget e)))
      (if
        (and
          (< 2 (length elst))
          (vl-every '(lambda (x) (not (zerop (cdr x)))) elst)     
        )
        (ssadd e ssrc)
      )
      (setq i (1+ i))
    )
  )
  (sssetfirst nil ssrc)
  (princ)
) ;end


[ElpanovEvgeniy]

......

Code: [Select]

(setq ss(ssget "x" '((0 . "LWPOLYLINE") (410 . "Model")(-4 . "/=")(42 . 0))))......

[ElpanovEvgeniy]

Closed polyline..

Code: [Select]

(setq ss(ssget "x" '((0 . "LWPOLYLINE") (410 . "Model")(70 . 1)(-4 . "/=")(42 . 0))))

[Joe Burke]

Thanks,

That's what I didn't know how to do.

[ElpanovEvgeniy]

In a cloud, all codes 42 are equal!

[MP]

Stratospherically speaking of course.

 

[CAB]

Shoot, beat me to it.
Well you could add dxf 90 with a minimum number of vertex to further filter the selection.

Code: [Select]

(setq ss (ssget "x" '((0 . "LWPOLYLINE")(410 . "Model")(-4 . "/=")(42 . 0.0)(-4 . ">")(90 . 4))))

[Joe Burke]

Thanks Alan,

Yes, I need that too.

[GDF]

If they are on the same layer, just delete the layer.

Code: [Select]

(defun C:DEL-LAYER  (/ n ent acapp acsp adoc allrs layer_name TotalNumber CurrNumber)
  (vl-load-com)
  (setq n 1)
  ;;(setq layer_name (getstring t "\n* Enter Layer name to Delete : "))
  (setq ent   (entsel "\nSelect object on Delete Layer")
layer_name (cdr (assoc 8 (entget (CAR ent))))
  )
  (setq acapp (vlax-get-acad-object)
adoc  (vla-get-activedocument acapp)
acsp  (vla-get-block (vla-get-activelayout adoc))
allrs (vla-get-layers adoc)
  )
  (setq TotalNumber (sslength (ssget "_X" (list (cons 8 layer_name)))) CurrNumber 1)
  ;;(princ "\n Total deleted object - ")(princ TotalNumber)(terpri)
  (if (member "acetutil.arx" (arx))
    (ACET-UI-PROGRESS-INIT
      "Please Wait while the Program is Running"
      TotalNumber
      )
    )
  ;;added progress bar start   
  (or (eq (vla-get-freeze (vla-item allrs layer_name)) :vlax-true)
    (vla-put-freeze (vla-item allrs layer_name) :vlax-false)
  )
  (or (eq (vla-get-lock (vla-item allrs layer_name)) :vlax-true)
    (vla-put-lock  (vla-item allrs layer_name) :vlax-false)
  )
  (or (eq (vla-get-layeron (vla-item allrs layer_name)) :vlax-false)
    (vla-put-layeron (vla-item allrs layer_name) :vlax-true)
  )     
 
  (vlax-for lt (vla-get-layouts adoc)
    (vlax-for ob (vla-get-block lt)
      (if (eq (vla-get-layer ob) layer_name)
(progn
;;(grtext -1 (strcat "Deleted " (itoa CurrNumber) " of " (itoa Totalnumber)))   
         (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-SAFE n)(ARCH:WORKING))         
         ;;added progress bar running     
         (setq n (+ n 1))
         ;;added progress bar count marker           
(vla-delete ob)         
(vlax-release-object ob)         
)       
      )
    )
  )
  ;;(vla-regen adoc acallviewports)
  (if (member "acetutil.arx" (arx))(ACET-UI-PROGRESS-DONE))
  ;;added progress bar finish
  (princ)
)


[Joe Burke]

Gary,

The reason I chose to select the revclouds, rather than simply delete them, is any such routine cannot be bulletproof in terms of only finding lwplines which were created using the revcloud command.

Select first, then visually check the selection. If it looks OK, then erase.

[ElpanovEvgeniy]

Gary,

The reason I chose to select the revclouds, rather than simply delete them, is any such routine cannot be bulletproof in terms of only finding lwplines which were created using the revcloud command.

Select first, then visually check the selection. If it looks OK, then erase.

My cent 

Code: [Select]

(defun c:SRC-1 (/ ss)
 (if (setq ss (ssget "x" '((0 . "LWPOLYLINE") (410 . "Model") (70 . 1) (-4 . "/=") (42 . 0) (-4 . ">") (90 . 4))))
  (sssetfirst
   nil
   (progn
    (foreach x (mapcar (function cadr) (ssnamex ss))
     (if (null (vl-every (function =) (mapcar (function cdr) (vl-remove-if-not '(lambda (x) (= 42 (car x))) (entget x)))))
      (ssdel x ss)
     ) ;_ if
    ) ;_ foreach
    ss
   ) ;_ progn
  ) ;_ sssetfirst
 ) ;_ if
)

[Joe Burke]

Thanks, Evgeniy.

[OcCad]

How could someone go about freezing layers that the revclouds are currently on versus deleting them? And when i say layers, i mean multiple revision clouds on layers that correspond to its date or delta number.

ex:

s-anno-revc-1   s-anno-revc-A   s-anno-revc-080112   
s-anno-revc-2   s-anno-revc-B   s-anno-revc-080214
s-anno-revc-3   s-anno-revc-C   s-anno-revc-080303

Also i would prefer a way that would not require me to list each individual layer as it varies from job to job.

[CAB]

Code: [Select]

(command "-layer" "F" "s-anno-revc*" "")

[OcCad]

Is there a faster way to modify multiple drawings for this other than a batch?

processes i would like to run are:

   (setvar "clayer" "0")
   (command "-layer" "freeze" "s-anno-revc*" "")

   (if (tblsearch "layer" revlay)
     (command "-layer" "thaw" revlay "")
   );if