Searching for a Lisp draws lines in each layer

[asos2000]

Is there a lisp draw a line in each layer and adding a text with the layer name?

 

Attached an image showing my request

[LCE]

Could do it in vba, or even vb.net if that is acceptable.

If you specifically want lisp then you will have to wait for someone else.

 

Cheers

[asos2000]

Both are ok

 

can that file be ocx im trying to avoid loading the macro

 

thanx LCE

[Arch_Eric]

Try this...

Code in post below

[LCE]

Extract attached zip.

in acad type -vbarun

then enter "directory\DrawLays.dvb!DrawLays"

where directory is the directory to which you extracted the dvb

 

Let me know if you have any problems.

 

I haven't added any error handling yet so if you cancel it will give an error.

 

Cheers

[asos2000]

Arch_Eric

 

i didn't get it

 

is it an AutoCAD command, or what

[Arch_Eric]

I screwed something up in my code...here's the revised version...

(defun c:layerlegend (/ osm ortho clayer celtype cecolor start-point line-length text-height *error*)
(defun *error* (msg)
 (setvar "osmode" osm)
 (setvar "orthomode" ortho)
 (setvar "clayer" clayer)
 (setvar "celtype" celtype)
 (setvar "cecolor" cecolor)
 (princ msg)
)

(defun mfp (pt pa) (list (+ (car pt) (car pa)) (+ (cadr pt) (cadr pa)) (+ (caddr pt) (caddr pa))))

(setq osm (getvar "osmode"))
(setq ortho (getvar "orthomode"))
(setq clayer (getvar "clayer"))
(setq celtype (getvar "celtype"))
(setq cecolor (getvar "cecolor"))
(setq start-point (getpoint "\nSelect point to start legend: "))
(setvar "orthomode" 1)
(setq line-length (getdist start-point "\nEnter length of line or click end point: "))
(setq text-height (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
(setvar "osmode" 0)
(setvar "clayer" (cdr (assoc 2 (tblnext "Layer" T))))
(setvar "celtype" "ByLayer")
(setvar "cecolor" "ByLayer")
(command "_line" start-point (mfp start-point (list line-length 0 0)) "")
(command "-text" (mfp start-point (list 0 1 0)) "0" (getvar "clayer"))
(while (setq layer (tblnext "Layer"))
 (setvar "clayer" (cdr (assoc 2 layer)))
 (setq start-point (mfp start-point (list 0 (- 0 (+ text-height 4)) 0)))
 (command "_line" start-point (mfp start-point (list line-length 0 0)) "")
 (command "-text" (mfp start-point (list 0 1 0)) "0" (getvar "clayer"))
)
(setvar "osmode" osm)
(setvar "orthomode" ortho)
(setvar "clayer" clayer)
(setvar "celtype" celtype)
(setvar "cecolor" cecolor)
)

[Arch_Eric]

Code assumes you have a default text height in your style.

[LCE]

See attached.

Error handling added with a few other tweaks.

[asos2000]

Thanx Mr. LCE that what I am locking for.

 

Arch_Eric at first Sorry for miss understand, my mother tongue is Arabic

second thanx for the lisp

The lisp is OK, but its effected for current layer only not for all layers

[LCE]

Thanx Mr. LCE that what I am locking for.

You are welcome.

[sprinkle]

I know this is an old thread, but LCE (or any one else that saved it) I would love to have this lisp file if you still have it. Thanks!

[Lee Mac]

Maybe something like this?

 

([color=BLUE]defun[/color] c:legend ( [color=BLUE]/[/color] df i ln p1 pt sp ) [color=GREEN];; Lee Mac 2011[/color]
 ([color=BLUE]if[/color]
   ([color=BLUE]and[/color]
     ([color=BLUE]setq[/color] pt ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify Point for Legend: "[/color]))
     ([color=BLUE]setq[/color] ln ([color=BLUE]getdist[/color]  [color=MAROON]"\nSpecify Length of Lines: "[/color] pt))
     ([color=BLUE]setq[/color] pt ([color=BLUE]trans[/color] pt 1 0) i -1
           sp ([color=BLUE]*[/color] 1.5 ([color=BLUE]getvar[/color] 'TEXTSIZE))
     )
   )
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] df ([color=BLUE]tblnext[/color] [color=MAROON]"LAYER"[/color] ([color=BLUE]null[/color] df)))
     ([color=BLUE]entmakex[/color]
       ([color=BLUE]list[/color]
         ([color=BLUE]cons[/color] 0 [color=MAROON]"LINE"[/color])
         ([color=BLUE]cons[/color] 8  ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 df)))
         ([color=BLUE]cons[/color] 6 [color=MAROON]"ByLayer"[/color])
         ([color=BLUE]cons[/color] 39 0.0)
         ([color=BLUE]cons[/color] 62 256)
         ([color=BLUE]cons[/color] 10 ([color=BLUE]setq[/color]  p1 ([color=BLUE]polar[/color] pt ([color=BLUE]*[/color] 1.5 [color=BLUE]pi[/color]) ([color=BLUE]*[/color] ([color=BLUE]setq[/color] i ([color=BLUE]1+[/color] i)) sp))))
         ([color=BLUE]cons[/color] 11 ([color=BLUE]polar[/color] p1 0. ln))
         ([color=BLUE]cons[/color] 370 -1)
       )
     )
     ([color=BLUE]entmakex[/color]
       ([color=BLUE]list[/color]
         ([color=BLUE]cons[/color] 0 [color=MAROON]"TEXT"[/color])
         ([color=BLUE]cons[/color] 7 ([color=BLUE]getvar[/color] 'TEXTSTYLE))
         ([color=BLUE]cons[/color] 8 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 df)))
         ([color=BLUE]cons[/color] 6 [color=MAROON]"ByLayer"[/color])
         ([color=BLUE]cons[/color] 39 0.0)
         ([color=BLUE]cons[/color] 62 256)
         ([color=BLUE]cons[/color] 10 p1)
         ([color=BLUE]cons[/color] 40 ([color=BLUE]getvar[/color] 'TEXTSIZE))
         ([color=BLUE]cons[/color] 1  ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 2 df)))
         ([color=BLUE]cons[/color] 370 -1)
       )
     )
   )
 )
 ([color=BLUE]princ[/color])
)

[sprinkle]

That is perfect! Thank you!

[Lee Mac]

You're welcome sprinkle

[phani_sai]

Searching for LISP draws lines in each layer alongwith text of layername and layerdescription

[phani_sai]

Hi Lee Mac,

 

Searching for LISP draws lines in each layer alongwith text of layername and layerdescription.

[BIGAL]

Our other Civil software has this as a default option but with do blocks as well, grid, so you end up with a wall chart maybe version 2 ?

[Organic]

Our other Civil software has this as a default option but with do blocks as well, grid, so you end up with a wall chart maybe version 2 ?

 

Which civil program is that?

[BIGAL]

Civilcad has been in it since the 80's also dump your library styles as text files manipulate and reload I would like to see a CIV3d user do that in less than a month. Gave up on changing ours since supplied by Cad dealer it must have taken him months to set up. If it burped give it a style.