TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: HasanCAD on September 27, 2010, 10:52:20 AM
-
This lisp to create a line with layer color and ltype and text with layer name
But do not know how to go through the layer table.
(defun c:Layers ()
(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))
(while
(setq LayerLst0 (tblsearch "LAYER"))
(setq LayerLst1 (ssname LayerLst0 (setq Cntr (1+ Cntr))))
(setq LayerLst2 (entget LayerLst1))
(if
(and
(setq Pnt1 (list (+ (car pnt0) 500) (cadr pnt0) (caddr pnt0)))
(setq Pnt2 (list (+ (car pnt0) 600) (cadr pnt0) (caddr pnt0)))
)
(progn
(entmakex (list
(cons 0 "LINE")
(cons 10 Pnt0)
(cons 11 Pnt1)
))
(entmakex (list
(cons 0 "TEXT")
(cons 10 Pnt2)
(cons 40 110)
(cons 1 (getvar "CLayer"))
))
(setq Pnt0 (list (car pnt0) (+ (car pnt0) 150) (caddr pnt0)))
)
)
(vla-EndUndoMark ActDoc)
)
(princ "\n Type c:Layers to start ")
)
-
The tblnext function is what you are looking for:
http://docs.autodesk.com/ACD/2011/ENU/filesALR/WS1a9193826455f5ff1a32d8d10ebc6b7ccc-6917.htm
-
(while (setq e (tblnext "LAYER" (null e)))
(setq l (cons (cdr (assoc 2 e)) l))
)
-
(vl-load-com)
(defun get-all-layers (doc show / res name)
;; doc -> vla-pointer to document to proceed. nil -> current
;; show -> show xref-layers (t) or nor (nil)
(vlax-for item (vla-get-layers (cond
((and doc (= (type doc) 'vla-object)))
(t (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of cond
) ;_ end of vla-get-layers
(setq name (vla-get-name item))
(if (or (not (wcmatch name "*|*"))
(and (wcmatch name "*|*")
show
) ;_ end of and
) ;_ end of or
(setq res (cons name res))
) ;_ end of if
) ;_ end of vlax-for
(vl-sort res '<)
) ;_ end of defun
-
This is final
LEE please DO NOT look at the header ;)
;;-------------------=={ Layers List }==----------------;;
;; ;;
;; 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 ;;
;; ;;
;; Copyright © 2010 by HasanCAD, All Rights Reserved. ;;
;; Contact: HasanCAD @ TheSwamp.org, ;;
;; asos2000 @ CADTutor.net ;;
;;------------------------------------------------------;;
;; Version: 1 20100928 ;;
;;------------------------------------------------------;;
;; o_l_ll \_ll o_l l \_l ;;
;;
(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
(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) 4000) (cadr pnt0) (caddr pnt0)))
(setq Pnt2 (list (+ (car pnt0) 4500) (cadr pnt0) (caddr pnt0)))
)
(progn
(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 40 110)
(cons 41 0.8)
(cons 62 LyrClr)
))
(setq Pnt0 (list (car pnt0) (+ (cadr pnt0) -200) (caddr pnt0)))
)
)
(vla-EndUndoMark ActDoc)
)
(princ)
)
;;
;; o_l_ll \_ll o_l l \_l ;;
-
I tried to make text alignment but create all test in 0,0
(entmakex (list
(cons 0 "TEXT")
(cons 1 LyrName)
(cons 7 "LyrNameTxt")
(cons 8 LyrName)
(cons 10 Pnt2)
(cons 40 220)
(cons 41 0.8)
(cons 62 LyrClr)
(cons 72 2)
(cons 73 2)
))
And this Version using Subroutine
;|-------------------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
Copyright © 2010 by HasanCAD, All Rights Reserved.
Contact: HasanCAD @ TheSwamp.org,
asos2000 @ CADTutor.net
HasanCAD@gmail.com
------------------------------------------------------
Version: 1 20100928
Version: 1.1 20100928 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) -110) (caddr pnt0)))
)
(progn
(LyrLnType LyrLType LyrName Pnt0 Pnt1 Pnt2 LyrClr)
(setq Pnt0 (list (car pnt0) (+ (cadr pnt0) -600) (caddr pnt0)))
)
)
(vla-EndUndoMark ActDoc)
)
(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 40 220)
(cons 41 0.8)
(cons 62 LyrClr)
))
)
; q_|_|| _\|| q_|| _\| ;
; Subroutine End ;
-
Very Cool!.
I would suggest two improvements. One draw the line and text in alphabetical order and two draw their lines with their correct line type settings.
Otherwise two comments, very cool.
-
Very Cool!.
I would suggest two improvements. One draw the line and text in alphabetical order and two draw their lines with their correct line type settings.
Otherwise two comments, very cool.
First Thanks for your encouragement and comments
for first one I Want to do this, but dont know How :-(
for second I am using the layer line type. Is it correct? or what?
-
...
for first one I Want to do this, but dont know How :-(
...
Write out in plain words what your current program is doing (this is called: "Pseudo Code"). After you do that we can talk.
-
...
for first one I Want to do this, but dont know How :-(
...
Write out in plain words what your current program is doing (this is called: "Pseudo Code"). After you do that we can talk.
I am answing MedOffBud improvements
For first improvement I want to arrange in alphabetical order but I dont know how.
For second improvement I didn't understand what he said, so I told him what I did.
Is it OK
-
Write out in plain words what your current program is doing (this is called: "Pseudo Code"). After you do that we can talk.
I am answing MedOffBud improvements
For first improvement I want to arrange in alphabetical order but I dont know how.
For second improvement I didn't understand what he said, so I told him what I did.
Is it OK
Sorry for the confusion on the second part. Your code is drawing a line on certain layer right? I was wondering why line was drawn as continuous when a layer (like a center line) should be drawn also with center line line type?
What Se7en "is trying to say" [before he hurts himself :evil:] is write out your code descriptively (Just words no code) on a piece of paper. I do mine with the classic "Step 1: blah blah blah" "Step 2: blah blah blah" and so on.
Is that a little clearer?
-
Sorry, but there goes the chance for help from me; not because of a misunderstanding but because of lack of trying to understand (Frankly, I didnt try to say anything, i said it. I said PSEUDO CODE and if that wasnt clear, then a google search would have helped).
http://lmgtfy.com/?q=pseudo+code