Moving objects within polyline to different layer

[Hsanon]

Hi, Is there a Lisp routine which can move all objects within a selected polyline to a layer called "exist" and all objects outside that same polyline to a layer called "site" ?? ignoring all frozen or OFF layers ?? Regards.

[Steven P]

If you want to have a go, look at Selection Sets to select everything within the polyline (see Lee Mac Selection sets page - it is rather good - ssget), window polygon or crossing polygon

Do 2 selection sets - one for everything "_X" and one for Crossing Polygon, I think Lee Mac has a routine there to remove one selection set from another.

This gives you 2 sets of entities to work with

Loads of LISPs out there to change layers.

 

Have a go, it is easier than you might think 

[aridzv]

Try this:

(defun c:chglyobjpl (/ acdoc p_list p_coord sset ent obj newLayerName i)

  (vl-load-com)
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))

;;;;;;;;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/selection-set-using-existing-polygon/td-p/11307274
;;;;;;;;;;;calderg1000 msg-7

  (setq p_list (entget (car (entsel "\nSelect the LwPolyline: "))))

  (if (setq
        p_coord (mapcar 'cdr
                        (vl-remove-if-not '(lambda (x) (= (car x) 10)) p_list)
                );;end setq p_coord
      );;end if condition
    (sssetfirst nil (setq sset (ssget "_wp" p_coord)))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;Select Objects In polygon;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (if sset
    (progn
      (setq newLayerName "exist") ;;(getstring T "\nEnter new layer name: "))
      (repeat (setq i (sslength sset))
        (setq i (1- i))
        (setq ent (ssname sset i))
        (setq obj (vlax-ename->vla-object ent))
        (vla-put-Layer obj newLayerName)
      );;repeat
      (vla-Regen acdoc acAllViewports)
      (sssetfirst nil nil)
    );;progn
    (princ "\nNo objects found in the drawing.")
  );;if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (princ)
);;end defun

 

Edited November 8 by aridzv

[Hsanon]

Thanks ...

but.....

on running the program, its saying that "no objects found in the drawing" and the program closes

 

[aridzv]

see new code.

make sure the layers names are correct.

(defun c:chglyobjpl (/ acdoc p_list p_coord sset ent obj newLayerName newLayerName1 i)

  (vl-load-com)
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (princ "\nSelect All Objects To Proccess")
  (setq ssall (ssget))
  (setq p_list (entget (car (entsel "\nSelect the Polyline Boundery For ''exist'' Layer: "))))
  (setq i 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects To site Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if ssall
  (progn
    (sssetfirst nil nil)
    (setq newLayerName1 "site");;(getstring T "\nEnter new layer name: "))
      (repeat (setq i (sslength ssall))
        (setq i (1- i))
        (setq ent (ssname ssall i))
        (setq obj (vlax-ename->vla-object ent))
        (vla-put-Layer obj newLayerName1)
      );;repeat
      (vla-Regen acdoc acAllViewports)
      (sssetfirst nil nil)
    );;progn
    (princ "\nNo objects found in the drawing.")
  );;if
;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects To site Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq ent nil)
  (setq obj nil)
  (setq i 0)
;;;;;;;;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/selection-set-using-existing-polygon/td-p/11307274
;;;;;;;;;;;calderg1000 msg-7
  (if (setq
        p_coord (mapcar 'cdr
                        (vl-remove-if-not '(lambda (x) (= (car x) 10)) p_list)
                );;end setq p_coord
      );;end if condition
    (sssetfirst nil (setq sset (ssget "_wp" p_coord)))
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;Select Objects In polygon;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (if sset
    (progn
      (sssetfirst nil nil)
      (setq newLayerName "exist");;(getstring T "\nEnter new layer name: "))
      (repeat (setq i (sslength sset))
        (setq i (1- i))
        (setq ent (ssname sset i))
        (setq obj (vlax-ename->vla-object ent))
        (vla-put-Layer obj newLayerName)
      );;repeat
      (vla-Regen acdoc acAllViewports)
      (sssetfirst nil nil)
    );;progn
    (princ "\nNo objects found in the drawing.")
  );;if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects To exist Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (sssetfirst nil nil)
  (princ)
);;end defun

 

 

Edited November 8 by aridzv

[BIGAL]

My $0.05 does not check for off or frozen layers.

(defun c:wow ( / ent co-ord ss)

(if (tblsearch "layer" "Site")
  (princ)
  (command "-layer" "Make" "Site" "c" 1 "" "")
)
(if (tblsearch "layer" "Exist")
  (princ)
  (command "-layer" "Make" "Exist" "c" 2 "" "")
)

(command "chprop" "all" "" "la" "Site" "")

(setq ent (car (entsel "\nPick the pline ")))

(setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(setq ss (ssget "WP" Co-ord))
(command "chprop" ss "" "LA" "Exist" "")

(princ)
)
(c:wow)

 

 

[Hsanon]

Hi,  many thanks for your help Aridzv and BigAl,

But, all entities are being converted to layer "site". The ones inside the pline are not being moved to layer "exist"

 

I'm attaching the drawing on which I am testing. 

 

surveytest.dwg

[aridzv]

@Hsanon

 

I tried both lisps and they work.

@BIGAL lisp works - after you run the command you need to select the boundery polygon.

with my lisp - before runnig it you need to make sure both "exist" and "site" layers exist.

in your case you need to create "exist" layer.

 

See attached Video using my lisp.

Edited November 10 by aridzv

[Hsanon]

And its not happening on my machine......am i doing anything wrong ???? is it an autocad issue ???

attaching a screen recording...

 

sorry to be such a bother !!!!!

[aridzv]

@Hsanon

the only way I can reproduse what you show is if "exist" layer dosen't exist.

I don't see that layer in the video you shared.

MAKE THIS LAYER BEFORE RUNNING THE LISP AS SHOWN IN MY VIDEO.

[Hsanon]

Dear Aridzv,  The layer was made..... 

the initial program was working fine, all objects were being moved to layer "site"

The second part was having an issue .... I feel it was not selecting the objects within the window / crossing polygon to convert the layer.

I did put a video (as an attachment ) ..... 

Shall do so again.... hope you can view it.

[aridzv]

@Hsanon

last try...

I used @BIGAL approch for layer criation code to force "exist" layer creation.

Beyond that, there's nothing I can think of...

 

see attached code:

(defun c:chglyobjpl (/ acdoc p_list p_coord sset ent obj newLayerName newLayerName1 i)

  (vl-load-com)
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))

  (if (not (tblsearch "layer" "site"))
    (command "-layer" "Make" "site" "c" 3 "" "")
  )

  (if (not (tblsearch "layer" "exist"))
    (command "-layer" "Make" "exist" "c" 50 "" "")
  )

  (princ "\nSelect All Objects To Proccess")
  (setq ssall (ssget))
  (setq p_list (entget (car (entsel "\nSelect the Polyline Boundery For ''exist'' Layer: "))))
  (setq i 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects To site Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if ssall
  (progn
    (sssetfirst nil nil)
    (setq newLayerName1 "site");;(getstring T "\nEnter new layer name: "))
      (repeat (setq i (sslength ssall))
        (setq i (1- i))
        (setq ent (ssname ssall i))
        (setq obj (vlax-ename->vla-object ent))
        (vla-put-Layer obj newLayerName1)
      );;repeat
      (vla-Regen acdoc acAllViewports)
      (sssetfirst nil nil)
    );;progn
    (princ "\nNo objects found in the drawing.")
  );;if
;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects To site Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq ent nil)
  (setq obj nil)
  (setq i 0)
;;;;;;;;;;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/selection-set-using-existing-polygon/td-p/11307274
;;;;;;;;;;;calderg1000 msg-7

  (if (setq
        p_coord (mapcar 'cdr
                        (vl-remove-if-not '(lambda (x) (= (car x) 10)) p_list)
                );;end setq p_coord
      );;end if condition
    (sssetfirst nil (setq sset (ssget "_wp" p_coord)))
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;Select Objects In polygon;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (if sset
    (progn
      (sssetfirst nil nil)
      (setq newLayerName "exist");;(getstring T "\nEnter new layer name: "))
      (repeat (setq i (sslength sset))
        (setq i (1- i))
        (setq ent (ssname sset i))
        (setq obj (vlax-ename->vla-object ent))
        (vla-put-Layer obj newLayerName)
      );;repeat
      (vla-Regen acdoc acAllViewports)
      (sssetfirst nil nil)
    );;progn
    (princ "\nNo objects found in the drawing.")
  );;if
;;;;;;;;;;;;;;;;;;;;;;;;;;;;Change Objects To exist Layer;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    

  (sssetfirst nil nil)
  (princ)
);;end defun

 

Edited November 11 by aridzv

[nod684]

I tried @aridzv first lisp and it's working fine on my end. Yellow ones are moved to layer "Site", the Red ones are moved to "exist" layer as what he mentioned.

Though these are all just rectang and PL. haven't tried it with blocks.

 

 

Edited November 11 by nod684

[mhupp]

6 hours ago, nod684 said:

I tried @aridzv first lisp and it's working fine on my end. Yellow ones are moved to layer "Site", the Red ones are moved to "exist" layer as what he mentioned.

Though these are all just rectang and PL. haven't tried it with blocks.

 

They are either on a locked layer. have an error msg saying # number entitys on locked layer can't move.

or inside a block or xref.

 

(setq ss (ssget "WP" Co-ord))              ; Select all entities in window polygon
(setq lock (ssget "WP:L" Co-ord))          ; Select entities not on locked layers
(setq n (- (sslength ss) (sslength lock))) ; Calculate difference
(if (> n 0)                                ; if n is greater than 0 display msg
  (prompt (strcat "\n" (itoa n) " entities on a locked layer"))
)

 

 

[Hsanon]

apologies for the delayed response..... 

Can you try out the program on these files???? It works just fine on a new file made up of simple oblects... but just doesn't work on typical files on which i have to work further.

Some times, it works on part of the objects.... (some objects get converted to "exist" layer and some dont)

Are there some objects the survey drawing has which are causing the program to mess up ???

 

Just last try.... otherwise ill get back to my painstaking manual changes.

Many many thanks

ganges Sugam Survey with Tree details 14.8.25.dwg JC 6 ROYED ST-Basu survey.dwg

[mhupp]

Might want to take those down and only upload a "Sample" drawing that doesn't have a title block with addresses and names or map.

 

-edit

Read this about polylines with arc's

https://www.cadtutor.net/forum/topic/76326-selection-set-that-selects-objects-inside-a-curved-polyline/#findComment-603264

I think final code is on page 2.

Edited 1 hour ago by mhupp