Jump to content

Please lisp to change each object to different layers.

Dien nguyen

By Dien nguyen
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Dien nguyen Apprentice

Dien nguyen

Posted
Posted

Hi everyone, currently I search for lisp that can convert objects into different layers, as shown in the picture, each polyline will be a layer, the layer is numbered from 1 to 255 with the corresponding color.

I searched but still have not seen so people have, please give me this lisp, because I changed manually for a long time.

Thank you

image.thumb.png.680ea2271bfbec541c51350ae47e3fdf.png

BASE.dwg

Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted

Does that mean there are supposed to be 255 polylines in total to be selected and changed? And does it matter which polyline ends up on which layer?

 

Thanks

Jonathan Handojo

Dien nguyen Apprentice

Dien nguyen

Posted
  • Author
Posted

 

4 hours ago, Jonathan Handojo said:

Does that mean there are supposed to be 255 polylines in total to be selected and changed? And does it matter which polyline ends up on which layer?

 

Thanks

Jonathan Handojo

 

59 minutes ago, BIGAL said:

When you get to 255 do you A1-A255 B1-B255 etc.

 

After end all 255 layers, can add a1-1 to a1-225 layer and more.

BIGAL Grand Master

BIGAL

Posted
Posted

Please explain why !

 

If you want to number the plines lots of ways. Text, Block, xdata.

Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted (edited)

I think the reason is color. The layer number is the same as the index color. Here's a small routine to help you out.

  

(defun JH:selset-to-list (selset / lst iter)
  (setq iter 0)
  (repeat (sslength selset)
    (setq lst (cons (ssname selset iter) lst)
	  iter (1+ iter))
    )
  (reverse lst)
  )

(defun c:pl_layer ( / *error* activeundo alphabet lay pls pls_list number alphabet exist)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  (setq pls (ssget '((0 . "LWPOLYLINE"))))
  
;;;  Uncomment below and comment/delete above if you'd like to select lines inclusive.
;;;  (setq pls (ssget '((0 . "*LINE"))))

  (if pls
    (progn
      (setq pls_list (JH:selset-to-list pls)
	    number 1
	    alphabet 64)
      (foreach i pls_list
	(setq exist (if (tblsearch "LAYER" (setq lay (strcat (if (> alphabet 64) (chr alphabet) "") (itoa number)))) T nil))
	(entmod
	  (subst
	    (cons 8 lay)
	    (assoc 8 (entget i))
	    (entget i)
	    )
	  )

	;; If you want the color of the new layer generated to change as well, uncomment below
	;; (if (not exist) (vla-put-Color (vla-item (vla-get-layers adoc) lay) number))
	
	(if (= number 255)
	  (setq number 1
		alphabet (1+ alphabet))
	  (setq number (1+ number))
	  )
	)
      )
    )
	     
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

 

Honestly, if you want to only change the colors of the lines, below is more than enough to do the job:

  

(vla-put-Color (vlax-ename->vla-object i) number)

or even (cons 62 number) is more than enough to do it.... much faster this way.

 

Anyway, as BIGAL points out, what are you trying to achieve in the end of this? Pretty sure there are more effective ways to get what you want other than putting each line in their separate layers.

 

Thanks,

Jonathan Handojo

Edited by Jonathan Handojo
  • Like 1
Dien nguyen Apprentice

Dien nguyen

Posted
  • Author
Posted (edited)
2 hours ago, Jonathan Handojo said:

I think the reason is color. The layer number is the same as the index color. Here's a small routine to help you out.

  


(defun JH:selset-to-list (selset / lst iter)
  (setq iter 0)
  (repeat (sslength selset)
    (setq lst (cons (ssname selset iter) lst)
	  iter (1+ iter))
    )
  (reverse lst)
  )

(defun c:pl_layer ( / *error* activeundo alphabet lay pls pls_list number alphabet exist)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )
  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  (setq pls (ssget '((0 . "LWPOLYLINE"))))
  
;;;  Uncomment below and comment/delete above if you'd like to select lines inclusive.
;;;  (setq pls (ssget '((0 . "*LINE"))))

  (if pls
    (progn
      (setq pls_list (JH:selset-to-list pls)
	    number 1
	    alphabet 64)
      (foreach i pls_list
	(setq exist (if (tblsearch "LAYER" (setq lay (strcat (if (> alphabet 64) (chr alphabet) "") (itoa number)))) T nil))
	(entmod
	  (subst
	    (cons 8 lay)
	    (assoc 8 (entget i))
	    (entget i)
	    )
	  )

	;; If you want the color of the new layer generated to change as well, uncomment below
	;; (if (not exist) (vla-put-Color (vla-item (vla-get-layers adoc) lay) number))
	
	(if (= number 255)
	  (setq number 1
		alphabet (1+ alphabet))
	  (setq number (1+ number))
	  )
	)
      )
    )
	     
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

 

Honestly, if you want to only change the colors of the lines, below is more than enough to do the job:

  


(vla-put-Color (vlax-ename->vla-object i) number)

or even (cons 62 number) is more than enough to do it.... much faster this way.

 

Anyway, as BIGAL points out, what are you trying to achieve in the end of this? Pretty sure there are more effective ways to get what you want other than putting each line in their separate layers.

 

Thanks,

Jonathan Handojo

 

Thanks Jonathan Handojo,

 

I need it because the node in dynamo requires separate layers to create a floor.
Can you handle the block?

 

 

cad.jpg

Edited by Dien nguyen
update image to high resolution
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted

If you're doing Revit, you're on the wrong forum my friend. But anyway...

 

If you mean selecting blocks too in addition to polylines, then:

  

(ssget
  '((-4 . "<OR")
    (0 . "INSERT")
    (0 . "LWPOLYLINE")
    (-4 . "OR>")
    )
  )

 

Grrr Veteran

Grrr

Posted
Posted

Hi,

You get this - 

(defun C:test nil 
  (vl-catch-all-apply
    (function 
      (lambda ( SS / id i n e enx )
        (or SS (exit))
        (or 
          (tblsearch "APPID" 
            (setq id 
              (apply ''((a b c)(a b c))
                '( (( f L ) (f (reverse (mapcar 'atoi (mapcar 'f L)))))
                  (( L ) (if L (strcat (chr (car L)) (f (cdr L))) ""))
                  ((49 49 49) (49 48 57) (57 55) (49 49 48)
                    (49 50 49) (49 48 48) (51 50) (49 49 53)
                    (49 48 49) (49 49 53) (49 49 55) (51 50)
                    (49 50 49) (49 49 55) (49 48 51) (51 50)
                    (49 49 53) (49 48 53) (49 48 52) (56 52)
                  )
                )
              )
            )
          )
          (repeat (progn (regapp id) (alert "\nCreating layers..") (1- (setq i 256)))
            (setq i (1- i))
            (setq n (itoa i))
            (or 
              (and 
                (setq e (tblobjname "LAYER" n))
                (setq e (entget e))
                (entmod (append e (list (cons 2 n))))
              )
              (entmakex 
                (append 
                  '((0 . "LAYER")(100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord"))
                  (list (cons 2 n) '(70 . 0) (cons 62 i))
                  '((290 . 1) (370 . -3))
                )
              )
            )
          )
        )
        (repeat (setq i (sslength SS))
          (setq enx (entget (ssname SS (setq i (1- i)))))
          (entmod (subst (cons 8 (itoa (rem i 256))) (assoc 8 enx) enx))
        )
      )
    )
    (list (ssget "_:L-I"))
  )
  (princ)
); defun

😀 because of this...

 

incompatible.jpg

ronjonp Grand Master

ronjonp

Posted
Posted (edited)
11 hours ago, Jonathan Handojo said:

If you're doing Revit, you're on the wrong forum my friend. But anyway...

 

If you mean selecting blocks too in addition to polylines, then:

  


(ssget
  '((-4 . "<OR")
    (0 . "INSERT")
    (0 . "LWPOLYLINE")
    (-4 . "OR>")
    )
  )

 

Or simply: 

(ssget '((0 . "INSERT,LWPOLYLINE")))

:)

Edited by ronjonp
Jonathan Handojo Experienced

Jonathan Handojo

Posted
Posted
4 minutes ago, ronjonp said:

Or simply: 


(ssget '((0 . "INSERT,LWPOLYLINE")))

:)

 

Or that works simpler... Lol, didn't thought of that, I forgot wildcards have that ability. Thanks.

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...