Author Topic: Is there a lisp layer break out  (Read 2674 times)

0 Members and 1 Guest are viewing this topic.

MSTG007

  • Gator
  • Posts: 2601
  • I can't remeber what I already asked! I need help!
Is there a lisp layer break out
« on: January 27, 2005, 08:21:25 AM »
Does anyone know of a lisp which will break out a drawing and places the lines and text on a new layer which the lisp makes driven by the color of the lines or text?

so if a green line is on the drawing...

you select the line and then it knows green line needs to be on a detail layer name with a color of green.

and it can do many objects at one time.

tell me what you think

thxs
Civil3D 2020

ELOQUINTET

  • Guest
Is there a lisp layer break out
« Reply #1 on: January 27, 2005, 09:25:00 AM »
hmmm that would be sweet but i'm not aware of anything lemme know if ya find a way

pmvliet

  • Guest
Is there a lisp layer break out
« Reply #2 on: January 27, 2005, 11:35:24 AM »
Would this be for file cleanup?
Would you want the routine to put the entities back onto by-layer properties once it is done? If I am reading this correct, you have someone who is drawing everything on one layer and just changing colors to achieve plotted weights.
I would say it is very doable, because doing it the long way via quick select you are able to do what you are asking. I don't have the knowledge but my vision says it could be done...

Pieter

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Is there a lisp layer break out
« Reply #3 on: January 27, 2005, 11:46:49 AM »
Pseudo code:
Prompt user to select item
extract items color
create a selection set of all entities in the dwg that were drawn in that color.

open layer config file
look for the colors layer
change sset to 'bylayer' and layer name from config file
done.


Example:
Select entity: (say a line that's green)
create a selection set of all green entities
go read the config file (it says green should be on layer 'demo')
modify all the entities in the selection set changing the color to 'bylayer' and put them on layer 'demo'

Sound about right?
TheSwamp.org  (serving the CAD community since 2003)

Andrea

  • Water Moccasin
  • Posts: 2372
Is there a lisp layer break out
« Reply #4 on: January 27, 2005, 12:06:24 PM »
not sure about the question....

 :roll:
Keep smile...

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Is there a lisp layer break out
« Reply #5 on: January 27, 2005, 02:22:45 PM »
Quote from: Andrea
not sure about the question....

 :roll:

MSTG007 was looking for a lisp app to handle the changing of entity layers, since no one had one I thought it would be easy enough to write one up so I posted some pseudo code for them to look over.
TheSwamp.org  (serving the CAD community since 2003)

MSTG007

  • Gator
  • Posts: 2601
  • I can't remeber what I already asked! I need help!
Is there a lisp layer break out
« Reply #6 on: January 27, 2005, 02:40:41 PM »
cool... thanks mark!
Civil3D 2020

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Is there a lisp layer break out
« Reply #7 on: January 27, 2005, 03:00:12 PM »
Quote from: MSTG007
cool... thanks mark!

Does the pseudo code sound like what you're looking for??
TheSwamp.org  (serving the CAD community since 2003)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Is there a lisp layer break out
« Reply #8 on: January 27, 2005, 03:38:09 PM »
Here is a code snepit that may give you some ideas.
Code: [Select]
;         (c) JAAKKO POYRY OY, Vantaa 1997


 ;---------------------------------------------------------------------------
 ;* File:      modeconv.lsp
 ;* Date:      15.5.1997
 ;* Author:    Juha Hanninen
 ;---------------------------------------------------------------------------
 ;*   Date    Author  Description of modifications:
 ;
 ;***************************************************************************

(defun c:modeconv


 ;* Purpose:
 ;    Convert drawings created with JPH MODE applications to client standard
 ;* Return value:
 ;* Usage:
 ;* Example:
 ;* Description:
 ;* Restrictions and Side Effects:
 ;* Global variables:
                  ( ;* Parameters:
                   / ;* Local variables:
                   pflag ; conversion type
                   cflag ; color definition type
                   tmp ; temporary variable
                   fname ; definition file name
)


  (initget "Color Layername")
  (setq pflag "Color"
        tmp   nil
        tmp   (getkword "\nChange Layername/<Color>: ")
  )
  (if tmp
    (setq pflag tmp)
  )


  (cond
    ((= pflag "Color")
     (initget "Bylayer Deffile")
     (setq fname ""
           cflag "Bylayer"
           tmp   nil
           tmp   (getkword "\nDeffile/<Bylayer>: ")
     )
     (if tmp
       (setq cflag tmp)
     )
     (if (= cflag "Deffile")
       (while (< (strlen fname) 1)
         (setq fname (getstring "\nColor definition file: "))
       )
     )
     (mode_browse_objects pflag fname cflag)
    )
    ((= pflag "Layername")
     (setq fname "")
     (while (< (strlen fname) 1)
       (setq fname (getstring "\nLayername definition file: "))
     )
     (mode_browse_objects pflag fname nil)
    )
  )
  (princ)
)


(defun mode_browse_objects


 ;* Purpose:
 ;    Browse all objects
 ;* Return value:
 ;* Usage:
 ;* Example:
 ;* Description:
 ;* Restrictions and Side Effects:
 ;* Global variables:
                           ( ;* Parameters:
                            pflag ; conversion type
                            fname ; definition file name
                            cflag ; color definition type
                            / ;* Local variables:
                            tb ; block table entity
                            en ; entity name
)


  (setq tb (tblnext "BLOCK" 1))
  (while tb
    (if (= pflag "Color")
      (mode_chg_color (cdr (assoc -2 tb)) fname cflag)
      (mode_chg_layer (cdr (assoc -2 tb)) fname nil)
    )
    (setq tb (tblnext "BLOCK"))
  )


  (setq en (entnext))
  (if (= pflag "Color")
    (mode_chg_color en fname cflag)
    (mode_chg_layer en fname nil)
  )


  (princ)
)


(defun mode_chg_color


 ;* Purpose:
 ;    Change color to bylayer or to a color from color definition file
 ;* Return value:
 ;* Usage:
 ;* Example:
 ;* Description:
 ;* Restrictions and Side Effects:
 ;* Global variables:
 ;    color_list    : list of old and new colors
                      ( ;* Parameters:
                       en1 ; entity name
                       fname ; definition file name
                       cflag ; color definition type
                       / ;* Local variables:
                       ed1 ; entity data
                       color ; entity color
                       newcol ; new color
)


  (if (= cflag "Deffile")
    (load fname)
  )


  (while en1
    (setq ed1   (entget en1)
          color (cdr (assoc 62 ed1))
    )
 ; New color
    (if (= cflag "Bylayer")
      (setq newcol 256)
      (if (and
            color
            color_list
            (setq newcol (assoc (read (strcat "X" (itoa color)))
                                color_list
                         )
            )
          )
        (setq newcol (nth 1 newcol))
      )
    )
 ; Change color
    (if (and color newcol)
      (progn
        (setq ed1 (subst (cons 62 newcol) (assoc 62 ed1) ed1))
        (entmod ed1)
        (entupd en1)
      )
    )
    (if (= (cdr (assoc 0 ed1)) "ENDBLK")
      (setq en1 nil)
      (setq en1 (entnext en1))
    )


  )
)


(defun mode_chg_layer


 ;* Purpose:
 ;    Change layer names
 ;* Return value:
 ;* Usage:
 ;* Example:
 ;* Description:
 ;* Restrictions and Side Effects:
 ;* Global variables:
 ;    layer_list    : list of old and new layer names
                      ( ;* Parameters:
                       en1 ; entity name
                       fname ; definition file name
                       cflag ; color definition type
                       / ;* Local variables:
                       ed1 ; entity data
                       ldata ; new layer name data
                       newcol ; new color
)


 ; Layer name definitions
  (load fname)


  (while en1
    (setq ed1 (entget en1))
 ; Change matching layer names
    (if (setq ldata (assoc (read (strcat "X" (cdr (assoc 8 ed1))))
                           layer_list
                    )
        )
      (progn
        (if (assoc 62 ed1) ; Color NOT
          bylayer
          (setq ed1 (subst (cons 62 (nth 2 ldata)) (assoc 62 ed1) ed1))
          (setq ed1 (cons (cons 62 (nth 2 ldata)) ed1))
        )
        (setq ed1 (subst (cons 8 (nth 1 ldata)) (assoc 8 ed1) ed1))
        (entmod ed1)
        (entupd en1)
      )
    )
    (if (= (cdr (assoc 0 ed1)) "ENDBLK")
      (setq en1 nil)
      (setq en1 (entnext en1))
    )
  )
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Andrea

  • Water Moccasin
  • Posts: 2372
Is there a lisp layer break out
« Reply #9 on: January 27, 2005, 07:44:26 PM »
CAB..

whath file supposed to get...to let this work ?

also you need to remove this...(in blue)



(progn
        (if (assoc 62 ed1) ; Color NOT
          bylayer
          (setq ed1 (subst (cons 62 (nth 2 ldata)) (assoc 62 ed1) ed1))
          (setq ed1 (cons (cons 62 (nth 2 ldata)) ed1))
        )

to let the program work..
Keep smile...

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Is there a lisp layer break out
« Reply #10 on: January 27, 2005, 11:00:20 PM »
Sorry that was a code snippet & not a complete routine. :?
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Mark

  • Custom Title
  • Seagull
  • Posts: 28762
Is there a lisp layer break out
« Reply #11 on: January 28, 2005, 08:17:14 AM »
Here's a simple one for ya.
Code: [Select]

(defun c:bEnnyAndthEjEts (/
                           ; local functions
                           get-color get-lay

                           ; local variables
                           color lay-name ss cntr ent entlst
                           )

  ;; local function
  ;; returns the color (DXF 62) of an entity or nil
  (defun get-color (/ ent)
    (if (setq ent (car (entsel "\nSelect entity: ")))
      (if (assoc 62 (entget ent))
        (cdr (assoc 62 (entget ent)))
        )
      )
    )

  (defun get-lay (/ ln)
    (if (/= (setq ln (getstring T "\nLayer Name: ")) "")
      ln nil
      )
    )

  (if (setq color (get-color))
    (setq lay-name (get-lay))
    )

  (if  lay-name
    (progn
      (setq ss (ssget "x" (list (cons 62 color)))
            cntr 0
            )

      (while (setq ent (ssname ss cntr))
             (setq entlst (entget ent))

             ;; change the color to 'bylayer'
             (setq entlst
                   (subst
                     (cons 62 256)
                     (assoc 62 entlst)
                     entlst
                     )
                   )

             ;; change the layer 'lay-name' (user input)
             (setq entlst
                   (subst
                     (cons 8 lay-name)
                     (assoc 8 entlst)
                     entlst
                     )
                   )
             (entmod entlst)

             (setq cntr (1+ cntr))
             )
      (princ (strcat "\n "(itoa (sslength ss)) " items changed"))
      )
    )
  (princ)
  )
TheSwamp.org  (serving the CAD community since 2003)