Lisp Routine for relayering lines

Hi All,

I'm new to this forum and relatively new to AutoCAD but I hope someone can help me out of a tight spot

The Problem

I need to isolate individual lines in a drawing and attach them to a newly created layer based on the line number. Something like line 10 on layer xyz010, line 11 on layer xyz011, etc (....for about 20000 lines!! )

A few of us here have tried different software, exporting dxf's, opening in excel as csv files and back and forth but all no avail.

I can hack around a bit in VBScript but not to any real standard in AutoCAD. I'm hoping someone here will be able to point me in the direction of a nice bit of code (Lisp or VB) to save the day!

Thanks in advance

Niall

When you say the line number - I would assume these lines are annotated?

I'm just trying to determine how one would identify one line from another among thousands.

Unfortunately they're not

Its just a mass of lines in one file (all on layer 0), however when I open the drawing as a dxf in another program I can see the string number (as well as start, all middle and end points on the line)

In the past, we isolated the line in AutoCAD, created a unique layer (xyz001) and added that line to the new layer. For a couple of hundred lines it was ok to do this manually (or not ). Not feasible for 20000+ lines tho

Ultimately it doesn't matter what line goes on each layer, as long as there is only one line on it

Ahh, well if it doesn't matter which line goes on which layer, and they are all on layer 0, it shouldn't be too hard..

I'll see what I can come up with

Try this:

; Re-layer Lines, by Lee McDonnell
; December 2008

(defun c:linlay    (/ *error* varLst oldVars ss ans ssl lay lay1 ent)
 ;     --- Error Trap ---

   (defun *error* (msg)
   (mapcar 'setvar varLst oldVars)
   (if (= msg "")
       (princ "\nFunction Complete.")
       (princ "\nError or Esc pressed... ")
   ) ;_  end if
   (princ)
   ) ; end of *error*

   (setq varLst  (list "CMDECHO" "CLAYER")
     oldVars (mapcar 'getvar varLst)
   ) ; end setq 

 ;    --- Error Trap ---

   (defun laymake (x)
   (if (not (tblsearch "Layer" x))
       (command "-layer" "m" x "")
   ) ;_  end if
   ) ;_  end defun

   (setvar "cmdecho" 0)
   (setq ss (ssget "X" (list (cons 0 "LINE") (cons 8 "0"))))
   (sssetfirst nil ss)
   (initget "Yes No")
   (setq ans (getkword "\nRe-layer Selected Lines? [Yes/No] <Yes> :"))
   (if    (/= ans "No")
   (progn
       (setq ssl (sslength ss)
         lay 0
       ) ;_  end setq
       (repeat ssl
       (setq lay1 (strcat "xyz0" (itoa lay)))
       (laymake lay1)
       (setq ent (entget (ssname ss lay)))
       (setq ent (subst (cons 8 lay1) (assoc 8 ent) ent))
       (entmod ent)
       (setq lay (+ 1 lay))
       ) ;_  end repeat
   ) ;_  end progn
   ) ;_  end if
   (*error* "")
   (princ)
) ;_  end defun

If you have any problems with it let me know

See the attachment for an example

Re-Layer Lines.zip

here's another one:

;;;WIZMAN 09DEC08 
(defun c:Lline (/ lline_count lline_set)
   (defun pad_0000 (startnumber)
(setq pad_var (strcat "0000" (itoa startnumber)))
   ) ;_ end_defun
   (defun pad_000 (startnumber)
(setq pad_var (strcat "000" (itoa startnumber)))
   ) ;_ end_defun
   (defun pad_00 (startnumber)
(setq pad_var (strcat "00" (itoa startnumber)))
   ) ;_ end_defun
   (defun pad_0 (startnumber)
(setq pad_var (strcat "0" (itoa startnumber)))
   ) ;_ end_defun
   (defun no_pad (startnumber)
(setq pad_var (itoa startnumber))
   ) ;_ end_defun
   (if	(and (setq lline_set (ssget '((0 . "LINE"))))
     (setq lline_count 0)
) ;_ end_and
(while (< lline_count (sslength lline_set))
    (entmod
	(subst
	    (cons 8
		  (strcat "XYZ"
			  (cond
			      ((< -1 lline_count 9) (pad_0000 (1+ lline_count)))
			      ((< 8 lline_count 99) (pad_000 (1+ lline_count)))
			      ((< 98 lline_count 999) (pad_00 (1+ lline_count)))
			      ((< 998 lline_count 9999) (pad_0 (1+ lline_count)))
			      (t (no_pad (1+ lline_count)))
			  ) ;_ end_cond
		  ) ;_ end_strcat
	    ) ;_ end_cons
	    (assoc 8
		   (entget (ssname lline_set lline_count))
	    ) ;_ end_assoc
	    (entget (ssname lline_set lline_count))
	) ;_ end_subst
    ) ;_ end_entmod
    (setq lline_count (1+ lline_count))
) ;_ end_while
   ) ;_ end_if
   (princ)
) ;_ end_defun

Lee/Wizman

That is brilliant, the only thing that is limiting me now is a slowcoach computer that grinds to a halt when it sees more than 500 lines

Now for the next challenge!!...

What if I have a line made up of a number of smaller lines (see attached image) and rather than each individual line on a unique layer, I put the entire line (highlighted) on a unique layer?

I also hacked around a bit this morning and tried to extend the code so that rather than put everything on layer xyz, I get a command line that says "What layer would you like to put these points on?", type in the layer eg abc and then relayer lines and come out with abc01, abc02, etc but I can't seem to manage the code.

Is there anywhere I could find a list of basic commands and syntax for programming in Lisp? Anything to further my somewhat limited technical ability!!

This would prompt for a layer prefix:

 ; Re-layer Lines, by Lee McDonnell
 ; December 2008

(defun c:linlay    (/ *error* varLst oldVars ss ans ssl lay lay1 ent)
 ;     --- Error Trap ---

   (defun *error* (msg)
   (mapcar 'setvar varLst oldVars)
   (if (= msg "")
       (princ "\nFunction Complete.")
       (princ "\nError or Esc pressed... ")
   ) ;_  end if
   (princ)
   ) ; end of *error*

   (setq varLst  (list "CMDECHO" "CLAYER")
     oldVars (mapcar 'getvar varLst)
   ) ; end setq 

 ;    --- Error Trap ---

   (defun laymake (x)
   (if (not (tblsearch "Layer" x))
       (command "-layer" "m" x "")
   ) ;_  end if
   ) ;_  end defun

   (setvar "cmdecho" 0)
   (setq ss (ssget "X" (list (cons 0 "LINE") (cons 8 "0"))))
   (sssetfirst nil ss)
   (initget "Yes No")
   (setq ans (getkword "\nRe-layer Selected Lines? [Yes/No] <Yes> :"))
   (if    (and
       (/= ans "No")
       (setq pre (getstring t "\nSpecify Layer Prefix: "))
   ) ;_  end and
   (progn
       (setq ssl (sslength ss)
         lay 0
       ) ;_  end setq
       (repeat ssl
       (setq lay1 (strcat pre (itoa lay)))
       (laymake lay1)
       (setq ent (entget (ssname ss lay)))
       (setq ent (subst (cons 8 lay1) (assoc 8 ent) ent))
       (entmod ent)
       (setq lay (+ 1 lay))
       ) ;_  end repeat
   ) ;_  end progn
   ) ;_  end if
   (*error* "")
   (princ)
) ;_  end defun

As for help with the LISP, I have mostly learnt from this forum and an AutoLISP R.11 reference manual (listing syntaxes etc) ... which was a bit old, but helped me start getting into LISP - but recently I have found an ACAD 2000 reference manual on the net - message me your email address and I'll send it to you if you want (too big file to post on forum - even zipped).

As for your issue with the multiple lines, it would be hard to tell ACAD when to recognise a group of lines and not just a single line, unless you made the group into a polyline and then in the:

(ssget "X" [i][filter list][/i])

you could include,

(list (cons 0 "LINE") [color=Red](cons 0 "LWPOLYLINE")[/color] (cons 8 "0")

And then it would work for a group of lines also, but it would mean making all the groups of lines in your drawing into polylines which is not an easy task. The following LISP will help, but this may not be the best solution:

(defun c:polyjoin (/ obs)
   (if
   (setq obs (ssget))
      (progn
          (command    "_.pedit" "M" obs "" "Y" "J" "0" "")
      ) ; end progn
      (alert "\nPlease Select Objects!")
   ) ; end if
   (princ)
) ; end program

Hope this Helps.

PM'd!

Looks like it'll take a while to get up to speed. If it had been writing VB macros for excel, I'd hit record and go back into the code to see what commands did what. This is not as easy in AutoCAD

Thanks for the help Lee, its given me a starting point to work from. I'll let you know in 6 months or so when I finally get my head around it!!!

Niall

please try, minimal testing done:

restriction is there should be no(edit) gap between lines

;;;WIZMAN 09DEC08 
(defun c:Lline (/ lay_count lline_set wiz_set fast_end fast_set fast_st)
   (defun pad_0000 (startnumber)
   (setq pad_var (strcat "0000" (itoa startnumber)))
   ) ;_ end_defun
   (defun pad_000 (startnumber)
   (setq pad_var (strcat "000" (itoa startnumber)))
   ) ;_ end_defun
   (defun pad_00 (startnumber)
   (setq pad_var (strcat "00" (itoa startnumber)))
   ) ;_ end_defun
   (defun pad_0 (startnumber)
   (setq pad_var (strcat "0" (itoa startnumber)))
   ) ;_ end_defun
   (defun no_pad (startnumber)
   (setq pad_var (itoa startnumber))
   ) ;_ end_defun
   (if    (and (setq lline_set (vl-remove-if
                'listp
                (mapcar 'cadr
                    (ssnamex (ssget '((0 . "LINE"))))
                ) ;_ end_mapcar
                ) ;_ end_vl-remove-if
        ) ;_ end_setq

        (setq lay_count 1)
   ) ;_ end_and
   (while lline_set
       (foreach x (setq wiz_set (wiz_fastsel (car lline_set)))
       (entmod
           (subst
           (cons 8
                 (strcat "XYZ"
                     (cond
                     ((< 0 lay_count 10) (pad_0000 lay_count))
                     ((< 9 lay_count 100) (pad_000 lay_count))
                     ((< 99 lay_count 1000) (pad_00 lay_count))
                     ((< 999 lay_count 10000) (pad_0 lay_count))
                     (t (no_pad lay_count))
                     ) ;_ end_cond
                 ) ;_ end_strcat
           ) ;_ end_cons
           (assoc 8
                  (entget x)
           ) ;_ end_assoc
           (entget x)
           ) ;_ end_subst
       ) ;_ end_entmod
       ) ;_ end_foreach
       (setq lay_count (1+ lay_count))
                   ;(setq lline_set (cdr lline_set))
       (setq lline_set (vl-remove-if
               '(lambda (x) (vl-position x wiz_set))
               lline_set
               ) ;_ end_vl-remove-if
       ) ;_ end_setq
   ) ;_ end_while
   ) ;_ end_if
   (princ)
) ;_ end_defun

(vl-load-com)
(defun wiz_fastsel (entity / fast_set_all)
   (foreach x
          (list
          (setq fast_st (vlax-curve-getstartpoint entity))
          (setq fast_end (vlax-curve-getendpoint entity))
          ) ;_ end_list

   (setq fast_st x)
   (entdel entity)
   (if (null fast_set_all)
       (setq fast_set_all (ssadd))
   ) ;_ end_if
   (while (or (setq fast_set (ssget fast_st '((0 . "LINE"))))
          (setq fast_set (ssget fast_end '((0 . "LINE"))))
          ) ;_ end_or
       (setq fast_set_all (ssadd (ssname fast_set 0) fast_set_all))
       (setq fast_st (vlax-curve-getstartpoint (ssname fast_set 0)))
       (setq fast_end (vlax-curve-getendpoint (ssname fast_set 0)))
       (entdel (ssname fast_set 0))
   ) ;_ end_while
;_ end_mapcar
   (entdel entity)
   ) ;_ end_foreach

   (mapcar 'entdel
       (vl-remove-if
       'listp
       (mapcar    'cadr
           (ssnamex fast_set_all)
       ) ;_ end_mapcar
       ) ;_ end_vl-remove-if
   ) ;_ end_mapcar
;_(sssetfirst nil (ssadd entity fast_set_all))
   (setq wiz_set_all
        (vl-remove-if
        'listp
        (mapcar 'cadr
            (ssnamex (ssadd entity fast_set_all))
        ) ;_ end_mapcar
        ) ;_ end_vl-remove-if
   ) ;_ end_setq
) ;_ end_defun