draw line on each layer

[CADWORKER]

Hai,

 

if I have a list of layers and I want to draw a line on every layer and at any selected point. can any lisp do it. It has to just draw lines parallel to other line at an offset.

orelse,

 

If there are certain layers present it has to just draw the lines at a length of 100mm and at a offset of 10mm at users selected point or else at 0,0. this units and length are just random for explaining the situation.

[Lee Mac]

Why should we donate our precious time to you, when you cannot even spend the time to reply to your other threads?

[Tharwat]

Why should we donate our precious time to you, when you cannot even spend the time to reply to your other threads?

1+

[paisis123]

and his name is CAD WORKER, that doesn't want to do anyponys drawings? pity.

[CADWORKER]

Why should we donate our precious time to you, when you cannot even spend the time to reply to your other threads?

 

I shall reply to other post now onwards, just I have very little access to internet from office. Just could not reply yesturday. But I have replied to tharwat through my e-mail.

 

Sorry once again

and thanks

[Tharwat]

But I have replied to tharwat through my e-mail.

 

When did that happen ?

[CADWORKER]

When did that happen ?

 

Tharwat, Iam sorry.

Anyways if you have not recieved my replies. Might have something to do with administrators or else?

I thank you many more times for your support.

Look at the attacments.

[Tharwat]

It is Ok my friend .

 

Try this code ....

 

(defun c:Test (/ l p1)
 (if (setq p1 (getpoint "\n Specify point :"))
   (while (setq l (tblnext "LAYER" (null l)))
     (entmakex (list '(0 . "LINE")
                     (cons 10 p1)
                     (cons 11 (polar p1 0.0 100.))
                     (cons 8 (cdr (assoc 2 l)))
               )
     )
     (setq p1 (polar p1 (/ pi 2.) 10.))
   )
   (princ)
 )
 (princ)
)

[CADWORKER]

Dear Tharwat,

 

Thanks a lot for this great peice of lisp and my wishes.

[Tharwat]

Dear Tharwat,

 

Thanks a lot for this great peice of lisp and my wishes.

 

You're welcome anytime .

[asos2000]

Try this one

;|-------------------Layers List----------------------
               q_|_|| _\|| q_|| _\|                  
                                                     
 Create a line & text for each layer and have        
 layer properties and text string is layer name      
 for each layer                                      
------------------------------------------------------
 Author: Hasan M. Asous, 2010                        
 Contact: HasanCAD @ TheSwamp.org,                   
          asos2000 @ CADTutor.net                    
          HasanCAD@gmail.com                         
------------------------------------------------------
 Version: 1      2010 09 28                             
 Version: 1.1   2010 09 28 Using Subroutine            
____________________________________________________|;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;
(defun c:Layers (/ AcObj ActDoc
	 Cntr Pnt0 
	 e l
	 Pnt1 Pnt2 LyrName LyrLType LyrClr)
 (vl-load-com)

 (setq AcObj (vlax-get-Acad-Object))
 (setq ActDoc (vla-get-ActiveDocument AcObj))
 (vla-EndUndoMark ActDoc)
 (vla-StartUndoMark ActDoc)

 (setq Cntr -1)
 (setq Pnt0 (trans (getpoint "\nBase point")1 0))
 
 (command "_.-style" "LyrNameTxt" "romans.shx" 110 0.8 0 "n" "n" "n") 
 
 (while
   (and
     (setq Lyr (tblnext "LAYER" (null Lyr)))
     (setq LyrName (cdr (assoc 2 Lyr)))
     (setq LyrLType (cdr (assoc 6 Lyr)))
     (setq LyrClr (cdr (assoc 62 Lyr)))
     )

   (if
     (and
  (setq Pnt1 (list (+ (car pnt0) 8000) (cadr pnt0) (caddr pnt0)))
  (setq Pnt2 (list (+ (car pnt0) 8200) (+ (cadr pnt0) 0) (caddr pnt0)))
  )
     (progn
(LyrLnType LyrLType LyrName Pnt0 Pnt1 Pnt2 LyrClr)
(setq Pnt0 (list (car pnt0) (+ (cadr pnt0) -600) (caddr pnt0)))
)
     )

 (vla-EndUndoMark ActDoc)
 )
(princ "\n  RFTRec.lsp ~ Copyright © by HasanCAD")
(princ "\n     ...Type LAYERS to Invoke...   ")
(princ)
 )
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;

(defun LyrLnType (LyrLType LyrName Pnt0 Pnt1 Pnt2 LyrClr / )

 (entmakex (list
      (cons 0  "LINE")
      (cons 6  LyrLType)
             (cons 8  LyrName)
      (cons 10 Pnt0)
             (cons 11 Pnt1)
      (cons 62 LyrClr)
      ))
 (entmakex (list
      (cons 0  "TEXT")
      (cons 1  LyrName)
      (cons 7  "LyrNameTxt")
      (cons 8  LyrName)
      (cons 10 Pnt2)
      (cons 11 Pnt2)
             (cons 40 220)
      (cons 41 0.
      (cons 62 LyrClr)
      (cons 72 0)
      (cons 73 2)
      ))
 )
;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;

[CADWORKER]

Thanks Asos2000,

 

your code is good, a small suggestion is there any way we can avoid all layers starting with B orelse we can make the layerlist only for the objects which has line, polyline, 3dpolyline, arc, circle.

 

Thanks in advance

Edited May 16, 2012 by CADWORKER

[teknomatika]

On 5/12/2012 at 7:40 PM, Tharwat said:

It is Ok my friend .

 

Try this code ....

 

 

(defun c:Test (/ l p1)
 (if (setq p1 (getpoint "\n Specify point :"))
   (while (setq l (tblnext "LAYER" (null l)))
     (entmakex (list '(0 . "LINE")
                     (cons 10 p1)
                     (cons 11 (polar p1 0.0 100.))
                     (cons 8 (cdr (assoc 2 l)))
               )
     )
     (setq p1 (polar p1 (/ pi 2.) 10.))
   )
   (princ)
 )
 (princ)
)

 

 

Tharwat, thanks for de routine.

 

Returning to this subject, testing the routine, I see that the listing does not correspond to the alphabetical order of the names of the different layers. Is this solution possible? Ideally, it would be interesting to write the name of the corresponding layer after each line.

Thanks!

 

[teknomatika]

On 5/14/2012 at 2:48 PM, asos2000 said:

Try this one

 

;|-------------------Layers List----------------------
               q_|_|| _\|| q_|| _\|                  
                                                     
 Create a line & text for each layer and have        
 layer properties and text string is layer name      
 for each layer                                      
------------------------------------------------------
 Author: Hasan M. Asous, 2010                        
 Contact: HasanCAD @ TheSwamp.org,                   
          asos2000 @ CADTutor.net                    
          HasanCAD@gmail.com                         
------------------------------------------------------
 Version: 1      2010 09 28                             
 Version: 1.1   2010 09 28 Using Subroutine            
____________________________________________________|;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;
(defun c:Layers (/ AcObj ActDoc
	 Cntr Pnt0 
	 e l
	 Pnt1 Pnt2 LyrName LyrLType LyrClr)
 (vl-load-com)

 (setq AcObj (vlax-get-Acad-Object))
 (setq ActDoc (vla-get-ActiveDocument AcObj))
 (vla-EndUndoMark ActDoc)
 (vla-StartUndoMark ActDoc)

 (setq Cntr -1)
 (setq Pnt0 (trans (getpoint "\nBase point")1 0))
 
 (command "_.-style" "LyrNameTxt" "romans.shx" 110 0.8 0 "n" "n" "n") 
 
 (while
   (and
     (setq Lyr (tblnext "LAYER" (null Lyr)))
     (setq LyrName (cdr (assoc 2 Lyr)))
     (setq LyrLType (cdr (assoc 6 Lyr)))
     (setq LyrClr (cdr (assoc 62 Lyr)))
     )

   (if
     (and
  (setq Pnt1 (list (+ (car pnt0) 8000) (cadr pnt0) (caddr pnt0)))
  (setq Pnt2 (list (+ (car pnt0) 8200) (+ (cadr pnt0) 0) (caddr pnt0)))
  )
     (progn
(LyrLnType LyrLType LyrName Pnt0 Pnt1 Pnt2 LyrClr)
(setq Pnt0 (list (car pnt0) (+ (cadr pnt0) -600) (caddr pnt0)))
)
     )

 (vla-EndUndoMark ActDoc)
 )
(princ "\n  RFTRec.lsp ~ Copyright © by HasanCAD")
(princ "\n     ...Type LAYERS to Invoke...   ")
(princ)
 )
;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;

(defun LyrLnType (LyrLType LyrName Pnt0 Pnt1 Pnt2 LyrClr / )

 (entmakex (list
      (cons 0  "LINE")
      (cons 6  LyrLType)
             (cons 8  LyrName)
      (cons 10 Pnt0)
             (cons 11 Pnt1)
      (cons 62 LyrClr)
      ))
 (entmakex (list
      (cons 0  "TEXT")
      (cons 1  LyrName)
      (cons 7  "LyrNameTxt")
      (cons 8  LyrName)
      (cons 10 Pnt2)
      (cons 11 Pnt2)
             (cons 40 220)
      (cons 41 0.
      (cons 62 LyrClr)
      (cons 72 0)
      (cons 73 2)
      ))
 )
;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;

 

 

asos2000,

Thanks.

 

Testing the routine, displays the malformed list message. Solved, when retesting it gives the message of "base point to many arguments".

Thanks!

[BIGAL]

A better version is to say limit the number of rows for the layers say 20 this way get a more rectangular result. The same is for a blocks legend.

 

Did see something I think recently about doing a legend of selected layers and blocks may have been forums/autodesk.

 

A typical dwg for us may have like 100 layers so a multi column answer is desirable. Some of the 3rd party software out there has option plot layers & blocks built in.

 

A google should provide some more code examples.

[ILoveMadoka]

I had to laugh at this one...

 

You guys solve problems that I didn't even know that I had!!

[teknomatika]

Thank you both. It will be.

[BIGAL]

Its a question like "watch this space" as more options are added, single column or max 20 as I suggested, line  spacing, then choices, name, linetype, description and so on.

 

Yes link is good could start there.