Jump to content

Searching for a Lisp draws lines in each layer


asos2000

Recommended Posts

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

 

Attached an image showing my request

LAYERS.JPG

Link to comment
Share on other sites

  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • asos2000

    4

  • LCE

    4

  • BIGAL

    3

  • Arch_Eric

    3

Top Posters In This Topic

Posted Images

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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)
)

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 3 years later...

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!

Link to comment
Share on other sites

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])
)

Link to comment
Share on other sites

  • 1 year later...
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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.


×
×
  • Create New...