Jump to content

Layer Table (Lines and Text)

CAD_Noob

By CAD_Noob
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

CAD_Noob Collaborator

CAD_Noob

Posted
Posted (edited)

I used THIS lisp by @pBe to create the layers from excel table. 

 

However, I need to create a table inside AutoCAD. Not an AutoCAD table but table consisting of lines and text. Currently I'm doing this manually and I think this can be automated since all the info are already inside. It Will be something like the image below. 

 

The Line in the first column resides on it's Layer Name and the number above the Line is the Layer Color. The Layer descriptions are already in the layer manager as well.

I attached the file as reference.

 

 

image.thumb.png.e8f8cd382b2329c06d31f0296447b8cc.png

TEST.dwg

Edited by CAD_Noob
typo
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

First suggestion make a "Table" of the desired result not lines and text can use the example dwg for the properties of the Table text size, column width etc.

Second suggestion is you can read Excel directly so post a sample Excel file.

 

Would it not be better to use a DWT where all the layers, linetypes and blocks are already available for use. 

 

Here is an example of reading an excel. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/required-a-lsp-to-make-automatic-topo-survey-by-creating-layer/td-p/12873977/page/2

Edited by BIGAL
CAD_Noob Collaborator

CAD_Noob

Posted
  • Author
Posted
10 minutes ago, nod684 said:

Nice program as always Tharwat.

I think what the OP need is create a table as attached for visual reference.

 

Yes this is exactly what I need

CAD_Noob Collaborator

CAD_Noob

Posted
  • Author
Posted

I tried asking AI but unfortunately it's not working.

  

;;; ------------------------------------------------------------------------
;;; Layer Table Builder
;;; Creates a table of all layers with a color swatch above a sample line,
;;; plus Layer Name and Layer Description columns.
;;; Text height is targeted at 2 mm on paper (asks for scale if in Model Space).
;;;
;;; Tested: AutoCAD 2015+ (VLIDE/Visual LISP)
;;; ------------------------------------------------------------------------

(vl-load-com)

;; ----------------------------
;; Helpers
;; ----------------------------

(defun _acad-doc () (vla-get-ActiveDocument (vlax-get-acad-object)))

(defun _cur-space (doc / )
  ;; Returns current space object (Model or Paper) based on CTAB.
  (if (= (getvar "CTAB") "Model")
    (vla-get-ModelSpace doc)
    (vla-get-PaperSpace doc)
  )
)

(defun _ensure-layer (doc layname color / laycol lays colobj)
  ;; Ensure a layer exists. Color is ACI index or nil (no change).
  (setq lays (vla-get-Layers doc))
  (if (not (tblsearch "LAYER" layname))
    (progn
      (vla-Add lays layname)
      (if color (vla-put-Color (vla-Item lays layname) color))
    )
  )
  (vla-Item lays layname)
)

(defun _3dpt (p) (vlax-3d-point p))

(defun _add-mtext (spc ins width str h / obj)
  (setq obj (vla-AddMText spc (_3dpt ins) width str))
  (vla-put-Height obj h)
  obj
)

(defun _ent-solid-rect (layer pmin pmax / x1 y1 x2 y2)
  ;; pmin = (x1 y1), pmax = (x2 y2)
  (setq x1 (car pmin)  y1 (cadr pmin)
        x2 (car pmax)  y2 (cadr pmax))
  (entmakex
    (list
      (cons 0 "SOLID")
      (cons 8 layer)
      (cons 10 (list x1 y2 0.0))
      (cons 11 (list x2 y2 0.0))
      (cons 12 (list x2 y1 0.0))
      (cons 13 (list x1 y1 0.0))
    )
  )
)

(defun _ent-line (layer p1 p2)
  (entmakex
    (list
      (cons 0 "LINE")
      (cons 8 layer)
      (cons 10 (list (car p1) (cadr p1) 0.0))
      (cons 11 (list (car p2) (cadr p2) 0.0))
    )
  )
)

(defun _ent-lwpoly (layer pts closed / n data)
  ;; pts: list of (x y). closed: T/NIL
  (setq n (length pts))
  (setq data
        (append
          (list (cons 0 "LWPOLYLINE")
                (cons 8 layer)
                (cons 90 n)
                (cons 70 (if closed 1 0))
          )
          (apply 'append
            (mapcar
              '(lambda (p) (list (cons 10 p) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0)))
              pts
            )
          )
        )
  )
  (entmakex data)
)

(defun _safe-str (x)
  (cond
    ((null x) "")
    ((= x "") "")
    (t x)
  )
)

(defun _layer-desc (vlaLayerObj / desc)
  (vl-catch-all-apply
    '(lambda ()
       (setq desc (vla-get-Description vlaLayerObj))
     )
  )
  (_safe-str desc)
)

(defun _is-xref-or-defpoints (vlaLayerObj)
  (or
    (vla-get-IsXRefDependent vlaLayerObj)
    (wcmatch (strcase (vla-get-Name vlaLayerObj)) "*|*") ;; xref-style name
    (= (strcase (vla-get-Name vlaLayerObj)) "DEFPOINTS")
  )
)

(defun _sort-ci (lst)
  (vl-sort lst
    (function
      (lambda (a b) (< (strcase a) (strcase b)))
    )
  )
)

;; ----------------------------
;; Main command
;; ----------------------------

(defun c:LAYERTABLE (/ doc spc oldlay ins inc-xref sortAZ spaceChoice sden mmPerUnit
                       th        ;; computed text height in current space
                       pad rowH wA wB wC tblLayer colLayer
                       layers laycol i n y0 x0 xA xB xC xR
                       hdrH titleH curtab)

  (setq doc (_acad-doc))
  (setq spc (_cur-space doc))
  (setq oldlay (getvar "CLAYER"))
  (setq curtab (getvar "CTAB"))

  ;; ---- Options & prompts ----
  (princ "\n=== Layer Table ===")
  (setq inc-xref (getkword "\nInclude XREF/DEFPOINTS layers? [Yes/No] <No>: "))
  (if (null inc-xref) (setq inc-xref "No"))
  (setq sortAZ (getkword "\nSort layers A->Z? [Yes/No] <Yes>: "))
  (if (null sortAZ) (setq sortAZ "Yes"))

  (setq spaceChoice (getkword (strcat "\nPlace in which space? [Current(" curtab ")/Model/Paper] <Current>: ")))
  (cond
    ((or (null spaceChoice) (= (strcase spaceChoice) "CURRENT"))
      ;; use current space
      )
    ((= (strcase spaceChoice) "MODEL")
      (setq spc (vla-get-ModelSpace doc))
     )
    ((= (strcase spaceChoice) "PAPER")
      (setq spc (vla-get-PaperSpace doc))
     )
  )

  ;; Scale: 2 mm text on paper -> convert to current space height
  ;; Ask: viewport scale denominator (1:xxx), default 1 when in Paper space, else 100
  (setq sden
        (cond
          ((= spc (vla-get-PaperSpace doc))  ;; Paper space
           (getint "\nViewport scale denominator (1:xxx). Paper space -> use 1. <1>: "))
          (t (getint "\nViewport scale denominator (1:xxx). Model space example: 100 for 1:100 <100>: "))
        )
  )
  (if (= spc (vla-get-PaperSpace doc))
    (if (or (null sden) (< sden 1)) (setq sden 1))
    (if (or (null sden) (< sden 1)) (setq sden 100))
  )

  ;; Ask: how many millimeters per drawing unit (unit conversion).
  ;; Common: mm drawing -> 1; meter drawing -> 1000; inch -> 25.4; foot -> 304.8
  (setq mmPerUnit (getreal "\nMillimeters per drawing unit? (mm=1, m=1000, in=25.4, ft=304.8) <1>: "))
  (if (or (null mmPerUnit) (<= mmPerUnit 0.0)) (setq mmPerUnit 1.0))

  ;; Text height in current space units:
  ;; th = (2 mm * scale denominator) / (mm per unit)
  (setq th (/ (* 2.0 sden) mmPerUnit))

  ;; Layout metrics
  (setq pad (* 0.5 th))         ;; inner padding
  (setq rowH (* 6.0 th))        ;; row height
  (setq hdrH (* 6.5 th))        ;; header row height
  (setq titleH (* 1.1 th))      ;; header text height
  ;; Column widths (scaled with text height)
  ;; Col A (swatch+line), Col B (Layer Name), Col C (Description)
  (setq wA (* 12.0 th)
        wB (* 40.0 th)
        wC (* 70.0 th)
  )

  ;; Target layers for graphics/text
  (setq tblLayer "LAYER_TABLE")
  (setq colLayer "LAYER_TABLE") ;; grid + text layer
  (_ensure-layer doc tblLayer 7)

  ;; Pick insertion point (top-left)
  (setq ins (getpoint "\nPick top-left corner of the table: "))
  (if (null ins) (progn (princ "\n*Cancelled*")(exit)))
  (setq x0 (car ins))
  (setq y0 (cadr ins))
  (setq xA (+ x0 wA))
  (setq xB (+ xA wB))
  (setq xC (+ xB wC))
  (setq xR xC) ;; right edge

  ;; Collect layer info
  (setq layers '())
  (vlax-for L (vla-get-Layers doc)
    (setq lname (vla-get-Name L))
    (if (or (not (wcmatch (strcase inc-xref) "NO"))
            (not (_is-xref-or-defpoints L))
        )
      (setq layers (cons (list lname L) layers))
    )
  )
  (if (wcmatch (strcase sortAZ) "YES")
    (setq layers
          (mapcar
            '(lambda (p) (list (car p) (cadr p)))
            (vl-sort layers
              (function (lambda (a b) (< (strcase (car a)) (strcase (car b)) )))
            )
          )
    )
  )

  (setq n (length layers))
  (if (= n 0) (progn (princ "\nNo layers found after filtering.")(exit)))

  ;; ----------------------------
  ;; Draw header grid
  ;; ----------------------------

  ;; Outer border
  (_ent-lwpoly colLayer
               (list (list x0 y0) (list xR y0) (list xR (- y0 hdrH)) (list x0 (- y0 hdrH)))
               T)

  ;; Header verticals
  (_ent-line colLayer (list xA y0) (list xA (- y0 hdrH)))
  (_ent-line colLayer (list xB y0) (list xB (- y0 hdrH)))

  ;; Header text
  (_add-mtext spc (list (+ x0 pad) (- y0 pad)) (- wA (* 2.0 pad)) "Color + Line" titleH)
  (_add-mtext spc (list (+ xA pad) (- y0 pad)) (- wB (* 2.0 pad)) "Layer Name"   titleH)
  (_add-mtext spc (list (+ xB pad) (- y0 pad)) (- wC (* 2.0 pad)) "Description"  titleH)

  ;; ----------------------------
  ;; Draw rows
  ;; ----------------------------
  (setq i 0)
  (repeat n
    (setq ytop (- y0 hdrH (* i rowH)))
    (setq ybot (- ytop rowH))

    ;; Row border
    (_ent-lwpoly colLayer
                 (list (list x0 ytop) (list xR ytop) (list xR ybot) (list x0 ybot))
                 T)
    ;; Row verticals
    (_ent-line colLayer (list xA ytop) (list xA ybot))
    (_ent-line colLayer (list xB ytop) (list xB ybot))

    ;; Data for this layer
    (setq lname (car (nth i layers)))
    (setq Lobj  (cadr (nth i layers)))
    (setq ldesc (_layer-desc Lobj))

    ;; --- Column A: Color Swatch (SOLID) above Sample Line ---
    (setq cellLeft x0)
    (setq cellRight xA)
    (setq cellTop ytop)
    (setq cellBot ybot)

    (setq swPad pad)
    (setq swW   (- wA (* 2.0 swPad)))      ;; swatch width
    (setq swH   (* 1.6 th))                ;; swatch height
    (setq swX1  (+ cellLeft swPad))
    (setq swX2  (+ swX1 swW))
    (setq swY1  (- cellTop swPad))         ;; top-down build
    (setq swY2  (- swY1 swH))              ;; swatch bottom

    ;; SOLID swatch on the layer
    (_ent-solid-rect lname (list swX1 swY2) (list swX2 swY1))

    ;; Sample line below swatch, centered
    (setq lnW (* 0.85 swW))
    (setq lnX1 (+ cellLeft (/ (- wA lnW) 2.0)))
    (setq lnX2 (+ lnX1 lnW))
    (setq lnY  (- swY2 (* 0.7 th))) ;; a bit below the swatch
    (_ent-line lname (list lnX1 lnY) (list lnX2 lnY))

    ;; --- Column B: Layer Name (MTEXT) ---
    (_add-mtext spc
                (list (+ xA pad) (- ytop pad))
                (- wB (* 2.0 pad))
                lname
                th)

    ;; --- Column C: Layer Description (MTEXT) ---
    (_add-mtext spc
                (list (+ xB pad) (- ytop pad))
                (- wC (* 2.0 pad))
                (if (= ldesc "") "<no description>" ldesc)
                th)

    (setq i (1+ i))
  )

  ;; Restore layer & finish
  (setvar "CLAYER" oldlay)
  (princ (strcat "\nLayer table created. Rows: " (itoa n) "."))
  (princ)
)

(princ "\nCommand loaded: LAYERTABLE  — Create a layer table with color swatches and lines.")
(princ)

 

nod684 Rising Star

nod684

Posted
Posted (edited)

I am not good as the others but try this. It will build what you want to achieve but not exactly as what was shown in the image.

Maybe other can improve the code.

  

(defun c:LayerLegend (/ doc lays lay laylist layname laycolor laydesc
                           pt x y starty rowH txtH headH colHT
                           col1 col2 col3 totalH
                           longestName longestDesc
                           legendBlock)

(vl-load-com)

(setq rowH 8.0)
(setq txtH 2.0)
(setq headH 2.5)
(setq colHT 1.0)

(setq col1 40.0)

(setq longestName 10)
(setq longestDesc 10)

(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq lays (vla-get-Layers doc))

(setq laylist '())

;; ---------------------------
;; COLLECT VALID LAYERS
;; ---------------------------
(vlax-for lay lays

(setq layname (vla-get-name lay))

(if (and
      (/= layname "0")
      (/= (strcase layname) "DEFPOINTS")
      (not (vl-string-search "|" layname))
    )
  (progn

    (setq laycolor (vla-get-color lay))

    (setq laydesc
      (if (vlax-property-available-p lay 'Description)
        (vla-get-description lay)
        "")
    )

    (setq laylist (cons (list layname laycolor laydesc) laylist))

    (if (> (strlen layname) longestName)
      (setq longestName (strlen layname)))

    (if (> (strlen laydesc) longestDesc)
      (setq longestDesc (strlen laydesc)))
  )
)

)

;; ---------------------------
;; SORT LAYERS
;; ---------------------------
(setq laylist
  (vl-sort laylist
    '(lambda (a b)
       (< (strcase (car a)) (strcase (car b)))
     )
  )
)

;; ---------------------------
;; AUTO COLUMN WIDTH
;; ---------------------------
(setq col2 (* longestName 1.8))
(setq col3 (* longestDesc 1.6))

;; ---------------------------
;; DELETE EXISTING LEGEND
;; ---------------------------
(if (setq legendBlock (tblsearch "BLOCK" "LAYERLEGEND_MARK"))
  (command "_.erase" "B" "LAYERLEGEND_MARK" "")
)

;; ---------------------------
;; INSERTION POINT
;; ---------------------------
(setq pt (getpoint "\nPick insertion point: "))
(setq x (car pt))
(setq y (cadr pt))
(setq starty y)

(setq totalH (* rowH (+ (length laylist) 1)))

;; ---------------------------
;; TOP BORDER
;; ---------------------------
(entmakex
 (list '(0 . "LINE")(cons 8 "0")
       (cons 10 (list x starty 0))
       (cons 11 (list (+ x col1 col2 col3) starty 0))))

;; ---------------------------
;; HEADERS
;; ---------------------------
(entmakex (list '(0 . "TEXT")(cons 8 "0")
 (cons 10 (list (+ x 3) (- y 5) 0))
 (cons 40 headH)
 (cons 1 "COLOR NUMBER")))

(entmakex (list '(0 . "TEXT")(cons 8 "0")
 (cons 10 (list (+ x col1 3) (- y 5) 0))
 (cons 40 headH)
 (cons 1 "LAYER NAME")))

(entmakex (list '(0 . "TEXT")(cons 8 "0")
 (cons 10 (list (+ x col1 col2 3) (- y 5) 0))
 (cons 40 headH)
 (cons 1 "DESCRIPTION")))

(entmakex
 (list '(0 . "LINE")(cons 8 "0")
 (cons 10 (list x (- y rowH) 0))
 (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0))))

(setq y (- y rowH))

;; ---------------------------
;; DRAW ROWS
;; ---------------------------
(foreach L laylist

(setq layname (nth 0 L))
(setq laycolor (nth 1 L))
(setq laydesc (nth 2 L))

;; color number
(entmakex
 (list '(0 . "TEXT")
 (cons 8 layname)
 (cons 10 (list (+ x 3) (+ y -2.2) 0))
 (cons 40 colHT)
 (cons 1 (itoa laycolor))))

;; sample line
(entmakex
 (list '(0 . "LINE")
 (cons 8 layname)
 (cons 10 (list (+ x 3) (- y 3) 0))
 (cons 11 (list (+ x col1 -3) (- y 3) 0))))

;; layer name
(entmakex
 (list '(0 . "TEXT")
 (cons 8 layname)
 (cons 10 (list (+ x col1 3) (- y 4) 0))
 (cons 40 txtH)
 (cons 1 layname)))

;; description
(entmakex
 (list '(0 . "TEXT")
 (cons 8 "0")
 (cons 10 (list (+ x col1 col2 3) (- y 4) 0))
 (cons 40 txtH)
 (cons 1 laydesc)))

;; row line
(entmakex
 (list '(0 . "LINE")(cons 8 "0")
 (cons 10 (list x (- y rowH) 0))
 (cons 11 (list (+ x col1 col2 col3) (- y rowH) 0))))

(setq y (- y rowH))
)

;; ---------------------------
;; VERTICAL GRID
;; ---------------------------
(entmakex (list '(0 . "LINE")(cons 8 "0")
(cons 10 (list x starty 0))
(cons 11 (list x (- starty totalH) 0))))

(entmakex (list '(0 . "LINE")(cons 8 "0")
(cons 10 (list (+ x col1) starty 0))
(cons 11 (list (+ x col1) (- starty totalH) 0))))

(entmakex (list '(0 . "LINE")(cons 8 "0")
(cons 10 (list (+ x col1 col2) starty 0))
(cons 11 (list (+ x col1 col2) (- starty totalH) 0))))

(entmakex (list '(0 . "LINE")(cons 8 "0")
(cons 10 (list (+ x col1 col2 col3) starty 0))
(cons 11 (list (+ x col1 col2 col3) (- starty totalH) 0))))

(princ)
)

 

Edited by nod684

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.

×
 Share
Go to topic listing
×
×
  • Create New...