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