Author Topic: Help: Layer polyline Area Table  (Read 1021 times)

0 Members and 1 Guest are viewing this topic.

mhy3sx

  • Newt
  • Posts: 166
Help: Layer polyline Area Table
« on: July 05, 2024, 10:48:48 AM »
Hi, I want to update a lisp code. This code selects the polylines from specific layers, calculate the sum area and export the results to a Table.

I want to filter the results. To understand exactly  what I want to do look the test.dwg file.

Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun c:Laytestfilter  ( / *error* acdoc ss p i e a d l) (vl-load-com)
  3.  
  4.   (defun *error* (msg)
  5.     (and
  6.       msg
  7.       (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
  8.       (princ (strcat "\nError: " msg))
  9.     )
  10.     (if
  11.       (= 8 (logand (getvar 'undoctl) 8))
  12.       (vla-endundomark acdoc)
  13.     )
  14.     (princ)
  15.     )
  16.  
  17.   (if
  18.     (and
  19.       (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "LAYER1,LAYER2,LAYER3,LAYER4,LAYER5,LAYER6,LAYER7"))))
  20.       (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
  21.     )
  22.     (progn
  23.       (repeat
  24.         (setq i (sslength ss))
  25.         (setq e (ssname ss (setq i (1- i)))
  26.               a (cdr (assoc 8 (entget e)))
  27.               d (vlax-curve-getarea e)
  28.         )
  29.         (if
  30.           (setq o (assoc a l))
  31.           (setq l (subst (list a (+ (cadr o) d)) o l))
  32.           (setq l (cons (list a d) l))
  33.         )
  34.       )
  35.       (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))
  36.  
  37.           (setq OldVars (mapcar 'getvar (setq VarList '(cmdecho clayer))))
  38.           (setvar 'cmdecho 0)
  39.  
  40.        (command "_layer" "_m" "TABLE" "_c" "7" "" "_Plot" "_No" "" "")
  41.  
  42.       (insert_table l p)
  43.       )
  44.     )
  45.   (*error* nil)
  46.   (princ)
  47.   )
  48.  
  49. (defun insert_table (lst pct / tab row col ht i n space)
  50.   (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  51.         ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
  52.         pct (trans pct 1 0)
  53.         n   (trans '(1 0 0) 1 0 T)
  54.         tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
  55.         )
  56.   (vlax-put tab 'direction n)
  57.  
  58.   (mapcar
  59.     (function
  60.       (lambda (rowType)
  61.         (vla-SetTextStyle  tab rowType (getvar 'textstyle))
  62.         (vla-SetTextHeight tab rowType ht)
  63.       )
  64.     )
  65.    '(2 4 1)
  66.   )
  67.  
  68.   (vla-put-HorzCellMargin tab (* 0.14 ht))
  69.   (vla-put-VertCellMargin tab (* 0.14 ht))
  70.  
  71.   (setq lst (cons '("Layer" "Total sq.m") lst))
  72.  
  73.   (setq i 0)
  74.   (foreach col (apply 'mapcar (cons 'list lst))
  75.     (vla-SetColumnWidth tab i
  76.       (apply
  77.         'max
  78.         (mapcar
  79.           '(lambda (x)
  80.              ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
  81.               (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
  82.               )
  83.              )
  84.           col
  85.           )
  86.         )
  87.       )
  88.     (setq i (1+ i))
  89.     )
  90.  
  91.   (setq lst (cons '("LAYER AREA TEST") lst))
  92.  
  93.   (setq row 0)
  94.   (foreach r lst
  95.     (setq col 0)
  96.     (vla-SetRowHeight tab row (* 1.5 ht))
  97.     (foreach c r
  98.       (vla-SetText tab row col (if (numberp c) (strcat (rtos (/ c 1) 2 2)) (vl-princ-to-string c)))
  99.       (setq col (1+ col))
  100.       )
  101.     (setq row (1+ row))
  102. (mapcar 'setvar VarList OldVars)
  103.     )
  104.   )
  105.  
  106.  

BIGAL

  • Swamp Rat
  • Posts: 1471
  • 40 + years of using Autocad
Re: Help: Layer polyline Area Table
« Reply #1 on: July 05, 2024, 07:34:01 PM »
Rather than make the table with a list just make the table with Title, Header and 1 Data row, fill in the 1st 2 details. then use Vl Insertrows to add the data rows. This will allow you to do l1 l2 l3 then a formula Area1 and so on. Just have the lst as layer name and area.

Code: [Select]
(vla-insertrows objtable  numrows  (vla-GetRowHeight objtable (1- numrows)) 1)
Start at numrows = 2.
A man who never made a mistake never made anything

mhy3sx

  • Newt
  • Posts: 166
Re: Help: Layer polyline Area Table
« Reply #2 on: July 06, 2024, 02:12:45 AM »
Hi BIGAL. I will try but i am not sure that I can fix this code  :idea: :idea: :idea:

Thanks

Stefan

  • Bull Frog
  • Posts: 320
  • The most I miss IRL is the Undo button
Re: Help: Layer polyline Area Table
« Reply #3 on: July 06, 2024, 10:45:50 AM »
Hi

I see that you add this table in an un-plottable layer. Is it really necessary to be a table? The code to create the table is larger than the main lisp.
The table is not linked to any object, the table content is set as "Text" and is not usable in any way, other than seeing the Check result.

Instead of table, is an MTEXT acceptable?

Try this and let me know if it works for you
Code - Auto/Visual Lisp: [Select]
  1. ;Stefan M., 06.07.2024
  2. (defun c:Laytestfilter  ( / *error* acdoc ss p i e a d l
  3.                          a1 a2 a3 a4 a5 a6 a7
  4.                          ch1 ch2 ch3
  5.                          ht str)
  6.  
  7.  
  8.   (if
  9.     (= 8 (logand (getvar 'undoctl) 8))
  10.     (vla-endundomark acdoc)
  11.   )
  12.  
  13.   (defun *error* (msg)
  14.     (and
  15.       msg
  16.       (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
  17.       (princ (strcat "\nError: " msg))
  18.     )
  19.     (if
  20.       (= 8 (logand (getvar 'undoctl) 8))
  21.       (vla-endundomark acdoc)
  22.     )
  23.     (princ)
  24.   )
  25.  
  26.   (if
  27.     (and
  28.       (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "LAYER1,LAYER2,LAYER3,LAYER4,LAYER5,LAYER6,LAYER7"))))
  29.       (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
  30.     )
  31.     (progn
  32.       (setq l '(("LAYER1" 0.0) ("LAYER2" 0.0) ("LAYER3" 0.0) ("LAYER4" 0.0) ("LAYER5" 0.0) ("LAYER6" 0.0) ("LAYER7" 0.0)))
  33.       (repeat
  34.         (setq i (sslength ss))
  35.         (setq e (ssname ss (setq i (1- i)))
  36.               a (cdr (assoc 8 (entget e)))
  37.               d (vlax-curve-getarea e)
  38.         )
  39.         (if
  40.           (setq o (assoc a l))
  41.           (setq l (subst (list a (+ (cadr o) d)) o l))
  42.           (setq l (cons (list a d) l))
  43.         )
  44.       )
  45.  
  46.       (mapcar
  47.         '(lambda (var val)
  48.            (set var (cond ((cadr val)) (0.0)))
  49.          )
  50.         '(a1 a2 a3 a4 a5 a6 a7)
  51.         l
  52.       )
  53.      
  54.       (setq ch1 (+ a3 a2 (- a1))
  55.             ch2 (- ch1 a4)
  56.             ch3 (+ a3 a5 (- a6) (- a7))
  57.       )
  58.  
  59.       (setq l (mapcar '(lambda (x) (if x (rtos x 2 2))) (list nil a1 a2 a3 ch1 a4 ch2 nil a3 a5 a6 a7 ch3)))
  60.  
  61.       (or
  62.         (tblsearch "Layer" "Table")
  63.         (entmakex
  64.          '(
  65.             (0 . "LAYER")
  66.             (100 . "AcDbSymbolTableRecord")
  67.             (100 . "AcDbLayerTableRecord")
  68.             (2 . "TABLE")
  69.             (70 . 0)
  70.             (62 . 7)
  71.             (6 . "Continuous")
  72.             (290 . 0)
  73.             (370 . -3)
  74.           )
  75.         )
  76.       )
  77.  
  78.       (setq str (apply 'strcat
  79.                   (mapcar
  80.                     '(lambda (a b)
  81.                        (if b
  82.                          (strcat a "\t" b "\\P")
  83.                          (strcat a "\\P")
  84.                        )
  85.                      )
  86.                     '("LAYER AREA TEST 1" "LAYER1" "LAYER2" "LAYER3" "Area1" "LAYER4" "Fist check" "LAYER AREA TEST 2" "LAYER3" "LAYER5" "LAYER6" "LAYER7" "Second check")
  87.                     l
  88.                   )
  89.                 )
  90.       )
  91.       (setq str (strcat "\\pxtr16;" str))
  92.  
  93.       (setq ht (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0))))
  94.  
  95.       (entmakex
  96.         (list
  97.           '(0 . "MTEXT")
  98.           '(100 . "AcDbEntity")
  99.           '(8 . "TABLE")
  100.           '(100 . "AcDbMText")
  101.           (cons 10 (trans p 1 0))
  102.           (cons 40 ht)
  103.           (cons 41 (* 20 ht))
  104.           (cons 1 str)
  105.           (cons 7 (getvar "TextStyle"))
  106.         )
  107.       )
  108.     )
  109.   )
  110.  
  111.   (*error* nil)
  112.   (princ)
  113.  
  114. )

mhy3sx

  • Newt
  • Posts: 166
Re: Help: Layer polyline Area Table
« Reply #4 on: July 07, 2024, 10:29:27 AM »
Hi Stefan. The code work, is not a table but ok. Can you modify the text a little better, like the image and dwg file?



Thanks


BIGAL

  • Swamp Rat
  • Posts: 1471
  • 40 + years of using Autocad
Re: Help: Layer polyline Area Table
« Reply #5 on: July 07, 2024, 08:13:39 PM »
Look into using Tabs to align and bold in MTEXT its via the extra coding

Code: [Select]
"{\\fArial|b1|i0;ABC\t\tdef\\fArial|b0|i0;\\Pc\t\tv\\PASDF\t\tV}\\P"
\\P is line break \t is tab

ABC      def
c      v
ASDF   V
A man who never made a mistake never made anything

mhy3sx

  • Newt
  • Posts: 166
Re: Help: Layer polyline Area Table
« Reply #6 on: July 08, 2024, 10:16:40 AM »
Hi BIGAL, can you give me an example how to overline and underline text?

I have  this line
Code: [Select]
   
      (setq str (apply 'strcat
                  (mapcar
                    '(lambda (a b)
                       (if b
                         (strcat a "\t" b "\\P")
                         (strcat a "\\P")
                       )
                     )
                    '("LAYER AREA TEST 1" "LAYER1" "LAYER2" "LAYER3" "Area1" "LAYER4" "Fist check" "LAYER AREA TEST 2" "LAYER3" "LAYER5" "LAYER6" "LAYER7" "Second check")
                    l
                  )
                )
      )

to make  "LAYER AREA TEST 1"  bold we write

Code: [Select]
"{\\fArial|b1|i0;LAYER AREA TEST 1}"     ; How to underline and how to 1 space line
            "{\\fArial|b1|i0;LAYER AREA TEST 2}"


If I want to make  "Fist check"  "Second check" red I try

Code: [Select]
"Fist check\\c1"  ;Is not working, and how to over line and add 2 space lines for the nexr check?
"Second check\\c1"


Thanks
« Last Edit: July 08, 2024, 10:42:43 AM by mhy3sx »

MatGrebe

  • Mosquito
  • Posts: 17
Re: Help: Layer polyline Area Table
« Reply #7 on: July 08, 2024, 11:24:34 AM »
Normal text {\Ooverline text} and {\Lunderline text} and normal again

BIGAL

  • Swamp Rat
  • Posts: 1471
  • 40 + years of using Autocad
Re: Help: Layer polyline Area Table
« Reply #8 on: July 08, 2024, 07:42:00 PM »
The simplest way is make a mtext and set it up as you want it all to look like then use Dumpit.lsp to show all the properties including textstring. Can use it on other objects a handy tool to have.

A man who never made a mistake never made anything

mhy3sx

  • Newt
  • Posts: 166
Re: Help: Layer polyline Area Table
« Reply #9 on: July 09, 2024, 03:24:12 AM »
Thanks BIGAL, works perfect
« Last Edit: July 09, 2024, 04:46:32 AM by mhy3sx »