autocadde auto table

[hamit]

Hello;
I've written before, and I felt the need to make a point out that I couldn't fully explain my problem.
I've got two lisps. One finds the total length, the other finds the total area.
In these 2 lisps, during the result, you should ask me the height and give the result of the process in a table form.
The table will write layer name, total (length or area), height and result.
In short, the total length and area will multiply by the height i specified and give it into tables.
I'm adding both lispi. Please don't spare your help.
Hamit from Turkey.

ALn.Lsp uo.lsp

[Emmanuel Delay]

Try this

 

Commands LIT for length, AIT for area, select the entities, press enter, select an insert point for the table.

 

I hardcoded the text height of the letters in the table: 2.5, and height of the cell: 4.0

 

Feel free to adapt these settings on top of the code

 

  ;; settings, text height, cel height
  (setq ht 2.5)
  (setq htc 4.0)

Code:

(vl-load-com)

(defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space)
  ;; settings, text height, cel height
  (setq ht 2.5)
  (setq htc 4.0)
 
  ;; document, model space, ...
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )

  (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht)  ))  ;;
  (vla-SetTextHeight tab 1 ht)
  (vla-SetTextHeight tab 2 ht)
  (vla-SetTextHeight tab 4 ht)
 
  (vla-put-VertCellMargin tab (* 0.14 ht))
 
  (setq i 0)
  (repeat (length lst)  ;; iterates the rows
    (vla-setrowHeight tab i htc)
    (setq row (nth i lst))
    (setq j 0)
    (repeat (length row)  ;; iterates the cols in the row
      ;;(princ "\n")
      ;;(princ  (nth j row))
      (vla-SetText tab i j (nth j row) )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
  ;; default Autocad expects a totle row.  If the first row has more than 1 cel, let's unmerge this row
  (if (> (length (nth 0 lst)) 1)
    (vla-unMergeCells tab 0 0 0 0)
  )
  tab
)

;; test of inserttable
(defun c:ila ( / )
  (inserttable
    (list
      (list "Length" "Height" "Total")
      (list "1.0" "2.0" "2.0")
      (list "2.0" "3.0" "6.0")
      (list "3.0" "4.0" "12.0")
    )
    (getpoint "\nInsert point of table: ")
  )
)

;;;;;;;;;;;;;;;;;

;; length of polyline, or most other (curved) lines, spline, ...
(defun length_curve (ent / )
  (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
)

;; area of polyline
(defun area_curve (ent / )
  (vlax-curve-getarea ent)
)

;; Length in table
(defun c:lit ( / lst h ent l a)
  (setq lst (list (list "Length" "Height" "Total")))
  (setq h (getreal "\nHeight: "))
  (princ "\nSelect polylines, then press enter: ")
  (while (setq ent (entsel "\nSelect object: "))
    (setq l (length_curve (car ent)))  ;; length
    ;;(setq a (area_curve (car ent)))    ;; area
    (setq lst (append lst (list
      (list (rtos l 2 3) (rtos h 2 3) (rtos (* h l) 2 3))
    )))
  )
  (inserttable lst (getpoint "\nInsert point of table: "))
  (princ)
)

;; Area in table
(defun c:ait ( / lst h ent l a)
  (setq lst (list (list "Area" "Height" "Total")))
  (setq h (getreal "\nHeight: "))
  (princ "\nSelect polylines, then press enter: ")
  (while (setq ent (entsel "\nSelect object: "))
    ;;(setq l (length_curve (car ent)))  ;; length
    (setq a (area_curve (car ent)))    ;; area
    (setq lst (append lst (list
      (list (rtos a 2 3) (rtos h 2 3) (rtos (* h a) 2 3))
    )))
  )
  (inserttable lst (getpoint "\nInsert point of table: "))
  (princ)
)

Edited September 16, 2019 by Emmanuel Delay

[hamit]

İlginiz için çok teşekkür ederim, efendim.
Gönderdiğin lispi denedim, çok işe yarıyor.ufak bir sorun var.
Seçtiğimde, her ikisinde de bir nesne seçebilirim. Bunu birden fazla seçenek yapabilir miyiz?
Ve birimler, mm, bunu bir metre yapabilir miyiz?
Cevabınızı dört gözle bekliyorum.
Ve en sol sekmedeki katman ad yazabilir?

Saygılar..

Edited September 17, 2019 by hamit

[Emmanuel Delay]

Google translated

When I select, I can select an object in both. Can we make it more than one option?
And units, mm, can we make it a meter?
I look forward to your answer.
And you can type the layer name in the leftmost tab?

 

- What do you mean I can select an object in both?

- units: Okay, in which units is the dwg?

 

[hamit]

Hello;
When I make the choice, I have to choose the polylines one by one. I want to select all the polylines in that layer in one choice. I want to make multiple choices. Dwg mm unit.
Regards..
 

[Emmanuel Delay]

Okay, try this for now

 

Make sure the units of your dwg are set to mm (it's not as flexible as it should be yet).

Selecting objects is a little more user friendly now.

The height you set should be set in metre.

See if this works for you.

 

(vl-load-com)

(defun inserttable (lst pt / ht htc tab i j row tb acObj acDoc space)
  ;; settings, text height, cel height
  (setq ht 2.5)
  (setq htc 4.0)
 
  ;; document, model space, ...
  (setq acObj (vlax-get-acad-object)
        acDoc (vla-get-activedocument acObj)
        space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
  )

  (setq tab (vla-addtable space (vlax-3d-point pt) (length lst) (length (cadr lst)) (* 1.1 ht) (* 10.0 ht)  ))  ;;
  (vla-SetTextHeight tab 1 ht)
  (vla-SetTextHeight tab 2 ht)
  (vla-SetTextHeight tab 4 ht)
 
  (vla-put-VertCellMargin tab (* 0.14 ht))
 
  (setq i 0)
  (repeat (length lst)  ;; iterates the rows
    (vla-setrowHeight tab i htc)
    (setq row (nth i lst))
    (setq j 0)
    (repeat (length row)  ;; iterates the cols in the row
      ;;(princ "\n")
      ;;(princ  (nth j row))
      (vla-SetText tab i j (nth j row) )
      (setq j (+ j 1))
    )
    (setq i (+ i 1))
  )
  ;; default Autocad expects a totle row.  If the first row has more than 1 cel, let's unmerge this row
  (if (> (length (nth 0 lst)) 1)
    (vla-unMergeCells tab 0 0 0 0)
  )
  tab
)

;; test of inserttable
(defun c:ila ( / )
  (inserttable
    (list
      (list "Length" "Height" "Total")
      (list "1.0" "2.0" "2.0")
      (list "2.0" "3.0" "6.0")
      (list "3.0" "4.0" "12.0")
    )
    (getpoint "\nInsert point of table: ")
  )
)

;; Converts units from the set units of the drawing to another unit.
;; notice, if the units of the DWG are set to unitless, this function returns nil.
;; LISP can't guess  the units of the drawn elements.
(defun convert_units (val un / res cunits unitnames)
  ;; 0: Unspecified (No units),  1: Inches,  2: Feet,  3: Miles,  4: Millimeters,  5: Centimeters,  6: Meters,  7: Kilometers,  8: Microinches,  9: Mils,  10: Yards,  11: Angstroms,  12: Nanometers,  13: Microns,  14: Decimeters,  15: Dekameters,  16: Hectometers,  17: Gigameters,  18: Astronomical Units,  19: Light Years,  20: Parsecs
  (setq unitnames (list "" "Inch" "Feet" "Miles" "mm"  "cm" "m" "km" "microinch" "Mil" "Yard" "Angstrom" "nm" "Micron" "dm" "dam" "Hm" "Gigameter" "AU" "Light Year" "Parsec"))
  (setq cunits (getvar "INSUNITS"))
  (setq res (cvunit val (nth cunits unitnames) (nth un unitnames)))
)

;; test convert_units.  (Light years doesn't seem to work)
(defun c:tlmr (/)
   (convert_units 1. 1)
   (convert_units 1. 2)
   (convert_units 1. 3)
   (convert_units 1. 4)
   (convert_units 1. 5)
   (convert_units 1. 6)
   (convert_units 1. 7)
   (convert_units 1. 
   (convert_units 1. 9)
   (convert_units 1. 10)
   (convert_units 1. 11)
   (convert_units 1. 12)
   (convert_units 1. 13)
   (convert_units 1. 14)
   (convert_units 1. 15)
   (convert_units 1. 16)
   (convert_units 1. 17)
   (convert_units 1. 18)
   (convert_units 1. 19)
   (convert_units 1. 20)
)

;;;;;;;;;;;;;;;;;

;; length of polyline, or most other (curved) lines, spline, ...
(defun length_curve (ent / )
  (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
)

;; area of polyline
(defun area_curve (ent / )
  (vlax-curve-getarea ent)
)

;; Length in table
(defun c:lit ( / lst h ent l a i ss)
  (setq lst (list (list "Layer" "Length" "Height" "Total")))
  (setq h (getreal "\nHeight: "))
  (princ "\nSelect polylines, then press enter: ")
  (setq i 0)
  (setq ss (ssget))
  ;;(while (setq ent (entsel "\nSelect object: "))
  (while (setq ent (ssname ss i))
    (setq l (length_curve ent))  ;; length
    (setq l (convert_units l 6))  ;; convert units
    (setq lst (append lst (list
      (list  
          (cdr (assoc 8 (entget ent)))
          (rtos l 2 3)
          (rtos h 2 3)
          (rtos (* h l) 2 3)
      )
    )))
    (setq i (+ i 1))
  )
  (inserttable lst (getpoint "\nInsert point of table: "))
  (princ)
)

;; Area in table
(defun c:ait ( / lst h ent l a i ss)
  (setq lst (list (list "Layer" "Area" "Height" "Total")))
  (setq h (getreal "\nHeight: "))
  (princ "\nSelect polylines, then press enter: ")
  (setq i 0)
  (setq ss (ssget))
  (while (setq ent (ssname ss i))
    ;;(setq l (length_curve ent))  ;; length
    (setq a (area_curve ent))      ;; area
    (setq a (/ a 1000000))         ;; mm² to m², divide by 1M
    (setq lst (append lst (list
      (list
          (cdr (assoc 8 (entget ent)))  
          (rtos a 2 3)
          (rtos h 2 3)
          (rtos (* h a) 2 3)
      )
    )))
    (setq i (+ i 1))
  )
  (inserttable lst (getpoint "\nInsert point of table: "))
  (princ)
)

 

[hamit]

Hello 
Thank you for your help. I'm going to scale the Dwg unit.
I still have a problem with object selection.
For example, there are 120 rectangles, and I want to choose them all at the same time. Not by clicking objects.

[hamit]

I continue to wait for the help of the masters on the subject.

[BIGAL]

It does select multiples (setq ss (ssget)) 

 

[hamit]

mr. bigal;
Since I don't know much about lisp, I have no idea how to do the information you provide. Can you arrange it in lisp if possible?

[hamit]

Can you help me get a total at the bottom of the total tab of the list that mr. Emmanuel Delay has helped me with.
Best regards

Edited October 22, 2019 by hamit

[hamit]

I'm waiting for the help of the masters on the subject.

[BIGAL]

Emmanuel missing 8 in code above will cause problems.

 

(convert_units 1. 7)
   (convert_units 1. 
   (convert_units 1. 9)