uzunluk * yükseklik = tablo

[black]

Selam.
İşimi hızlandırmak için yardımına ihtiyacım var. Ustaların konuyla ilgilenmelerini istiyorum.

Farklı yükseklikler dediğim bir polline çizime sahibim. Benim isteğim bu projeyi bir seçimde seçip, iç katmanların yüksekliğini sıralamak için bana sormak. Katmanın yükseklik değerini klavyeden sırayla gireceğim ve bana ekte gönderdiğimde sonucu tablo ile vereceğim.
1. Bulunduğu katmanın toplam uzunluğu * height = sonuç
2. Bulunduğu kat toplam alan * yükseklik = sonuç

İşlem sırası:
1 çizimden birini seçin
2 kat yüksekliğinde sorun
3 tablo oluşturun.

İngilizcem için özür dilerim.
Ekteki proje ve tabloyu inceleyiniz ...
 

 

test.dwg

Edited November 17, 2019 by black

[BIGAL]

Translated

Hi. 
I need your help to speed up my work, and I want the masters to take care of it. 
I have a polline drawing that I call different heights. My request is to select this project in an election and ask me to sort the height of the inner layers. I'll enter the height value of the layer in order from the keyboard, and when I send it to me in the appendix, I will give the result with a table. 
1. The total length of the layer in which it is located * height = result 
2. Floor total area * height = result 
Order of operation: 
Choose from 1 sketch 
2-storey height problem 
Create 3 tables. 
I'm sorry for my English. 
Check out the project and table attached ...

[black]

Forgive me. I made a mistake writing in translation.

[BIGAL]

Google "length of layer" as a start point

 

http://www.lee-mac.com/totallengthandarea.html

 

parse the number from layer name http://www.lee-mac.com/parsenumbers.html

Edited November 17, 2019 by BIGAL

[black]

11 hours ago, black said:

I know these programs from lee mac. What I want is to select the different layers in one choice and multiply them by the height I give from the keyboard and give the result. Look at the dwg I added.
Thank you for your attention.

 

test.dwg 67.5 kB · 4 downloads

 

[BIGAL]

This is total area via pick layer, second is volume by layer, yes I could have done all steps but it is good to see posters having a go. Finding out how to do it.

 

Try add a list of layers to search for then use repeat to get answer for each layer. Look at changing the while. Google making a table, you know how many layers so know how many rows to fill in then add . 

 

Tested on your dwg takes into account - or + for depth.

 

;;---------------------=={ Total Area }==---------------------;;
;;                                                            ;;
;;  Displays the total area of selected objects at the        ;;
;;  command line. The precision of the printed result is      ;;
;;  dependent on the setting of the LUPREC system variable.   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

; Total area modified by Alanh to allow multiple pick by layer
; Nov 2019

(defun c:tarea ( / a i s ent lay)
(while (setq ent  (entsel "pick object for layer"))
    (setq lay (vla-get-layer (vlax-ename->vla-object (car ent))))
	    (setq s
            (ssget
               '( (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")(cons 8 lay)
                    (-4 . "<NOT")
                        (-4 . "<AND")
                            (0 . "POLYLINE") (-4 . "&") (70 . 80)
                        (-4 . "AND>")
                    (-4 . "NOT>")
                )
            )
    )
    (if s
        (progn
            (setq a 0.0)
            (repeat (setq i (sslength s))
                (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i))))))
            )
            (alert (strcat "\nTotal Area for layer : " lay "  " (rtos a 2)))
        )
    )
)
    (princ)
)
(vl-load-com) (princ)
(c:tarea)

;;---------------------=={ Total Area }==---------------------;;
;;                                                            ;;
;;  Displays the total area of selected objects at the        ;;
;;  command line. The precision of the printed result is      ;;
;;  dependent on the setting of the LUPREC system variable.   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

; Total area modified by Alanh to allow multiple pick by layer
; uses height in layer name for volume expect metric
; Nov 2019

;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)

(defun c:tvol ( / a i s ent lay ht)
(while (setq ent  (entsel "pick object for layer"))
    (setq lay (vla-get-layer (vlax-ename->vla-object (car ent))))
	(setq ht (/ (nth 0 (LM:parsenumbers lay)) 1000.0))
	(if (= (substr lay 1 1) "H")(setq ht (abs ht)))
	(setq s 
            (ssget
               '( (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")(cons 8 lay)
                    (-4 . "<NOT")
                        (-4 . "<AND")
                            (0 . "POLYLINE") (-4 . "&") (70 . 80)
                        (-4 . "AND>")
                    (-4 . "NOT>")
                )
            )
    )
    (if s
        (progn
            (setq a 0.0)
            (repeat (setq i (sslength s))
                (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i))))))
            )
            (alert (strcat "\nTotal Area for layer : " lay "  " (rtos a 2) 
			"\n Total vol for height : " (rtos ht 2 3) "  " (rtos (* ht a) 2)))
        )
    )
    (princ)
)
)
(vl-load-com) (princ)
(c:tvol)

 

make-example-table.lsp

Edited November 17, 2019 by BIGAL

[black]

Mr. Bigal
Thank you so much for your interest, but I don't understand what you're writing. I'm not good at Lisp. I tried to do something, but I couldn't do it.

[BIGAL]

Ok need some time have to do other work.

[black]

Arrow. I'll be waiting for your help.
Thanks

[black]

Mr. bigal
I can manually enter the height values in the table of layers from the keyboard.
The layers will ask in order, and I will give the height value to these layers in order. Then he's going to put it on the table.

[BIGAL]

Ok the table needs a little bit of work but I seem to be getting what you have, need to check the answer on a smaller selection. Maybe change method rather than all. Is the volume to be true value + - negative or both added. Can fix by using ABS.

 

Once loaded pick layers then press enter pick point for table. To repeat type tvol.

 

;;---------------------=={ Total Area }==---------------------;;
;;                                                            ;;
;;  Displays the total area of selected objects at the        ;;
;;  command line. The precision of the printed result is      ;;
;;  dependent on the setting of the LUPREC system variable.   ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

; Total area modified by Alanh to allow multiple pick by layer
; uses height in layer name for volume expect metric
; Nov 2019

;; Parse Numbers  -  Lee Mac
;; Parses a list of numerical values from a supplied string.
;;  Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun LM:parsenumbers ( str )
    (   (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (mapcar
                           '(lambda ( a b c )
                                (if (or (< 47 b 58)
                                        (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                                        (and (= 46 b) (< 47 a 58) (< 47 c 58))
                                    )
                                    b 32
                                )
                            )
                            (cons nil l) l (append (cdr l) '(()))
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list str)
    )
)

(defun ahmktable ( numr / colwidth numcolumns numrows rowheight sp vgad vgao vgms)
(vl-load-com)
(setq sp (vlax-3d-point (getpoint "select point for table")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) ;
(setq numrows numr)
(setq numcolumns 5)
(setq rowheight 40)
(setq colwidth 200)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
(vla-settext objtable 0 0 "KALIP METRAJ"); TABLE TITLE
(vla-settext objtable 1 0 "No") 
(vla-settext objtable 1 1 "LAYER") 
(vla-settext objtable 1 2 "TOTAL AREA")
(vla-settext objtable 1 3 "HEIGHT")
(vla-settext objtable 1 4 "VOL")
(vla-SetTextHeight Objtable (+ acDataRow acTitleRow acHeaderRow) 12)
(vla-Setcolumnwidth Objtable  0 35)
(vla-Setcolumnwidth Objtable  1 300)
(vla-Setcolumnwidth Objtable  2 200)
(vla-Setcolumnwidth Objtable  3 100)
(vla-Setcolumnwidth Objtable  4 200)
(princ)
)


(defun c:tvol ( / a i s ent lay ht objtable lst lst2)
(setq lst '())

(while (setq ent  (entsel "pick object for layer <Enter> to exit"))
    (setq lay (vla-get-layer (vlax-ename->vla-object (car ent))))
    (setq lst (cons (list lay ) lst))
)

(setq lst2 '())

(repeat (setq x (length lst))
    (setq lay (car (nth (setq x (- x 1)) lst)))
    (setq ht (/ (nth 0 (LM:parsenumbers lay)) 1000.0))
    (if (= (substr lay 1 1) "H")(setq ht (abs ht)))
                                  
    (setq s (ssget "X"  (list (cons 0  "LWPOLYLINE")(cons 8 lay))))
    	
    (if s
        (progn
            (setq a 0.0)
            (repeat (setq i (sslength s))
                (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i))))))
            )
            (alert (strcat "\nTotal Area for layer : " lay "  " (rtos a 2) "\n Total vol for height : " (rtos ht 2 3) "  " (rtos (* ht a) 2 2)))
	        )
    )
	(setq lst2 (cons (list  lay  a  ht) lst2))
  )

(ahmktable  (+ (length lst2) 3))

(setq voltot 0)
(setq no 1)
(setq row 2)
(setq i 0)
(repeat (setq x (length lst2))
(setq itlst (nth i lst2))
(vla-settext objtable  row 0 (rtos no 2 0))
(vla-settext objtable  row 1 (car itlst))
(vla-settext objtable  row  2 (rtos (cadr itlst) 2 3))
(vla-settext objtable  row  3  (rtos (caddr itlst) 2 3))
(vla-settext objtable  row  4  (rtos (*(cadr itlst)(caddr itlst)) 2 3))
(setq voltot (+ (*(cadr itlst)(caddr itlst)) voltot))
(setq row (+ row 1))
(setq i (+ i 1))
(setq no (+ no 1))
)
(vla-mergecells objtable (+ (length lst2) 2) (+ (length lst2) 2) 0 3)
(vla-settext objtable (+ (length lst2) 2) 0 "TOTAL Vol.")
(vla-settext objtable  (+ (length lst2) 2)  4 (rtos voltot 2 3))

(princ)
)
(vl-load-com) (princ)
(c:tvol)

 

Edited November 20, 2019 by BIGAL

[black]

Mr. bigal
Thank you so much.
But I'm not good at autocate, and I couldn't do this parsenumbers thing. I googled it, but I couldn't find it.

[black]

7 hours ago, BIGAL said:

Mr. bigal
When I lisp and run the code you type, the pick object for layer question comes to the screen. Nothing changes when I click the lines. When I click in vain, the empty table comes. I couldn't solve the problem.

 

[BIGAL]

You select layers blue line, green line,  yellow line then press <enter> to stop pick.

 

Pick point for table.

 

 

[black]

On 18.11.2019 at 07:52, BIGAL said:

Parses a list of numerical values from a supplied string.

Mr. Bigal
I'm sorry, but it didn't work out. After selecting the layers, I say enter, the error message I come across is this:
 error: bad SSGET list

I'm running it with the Lispi tvol command.
I couldn't find any mistakes. Can you help?
 

[BIGAL]

Post your dwg.

 

Katmanlar için nesneyi seçin ve çekmeyi durdurmak için klavyedeki Enter tuşuna basın.

Sonra tablo için yan bir nokta seçin.

 

Pick the object for layers then press the Enter key on keyboard to stop picking.

Then pick a point to side for the table.

 

 

 

 

Edited November 19, 2019 by BIGAL

[black]

 

Mr. Bigal
I'm doing, but it didn't work. Would you please review and submit the project I sent?

test.dwg

Edited November 19, 2019 by black

[BIGAL]

I have been testing in Briscad and found a problem in Autocad. So changed code above please resave.

 

I have changed the selection to pick top right - bottom left.

 

 

test (6).dwg

[black]

Mr. Bigal 
You're a genius. It happened just the way I wanted it to. I have another request from you.

I have to pick the lines when I choose the layers. Can we solve this at once by putting it in the window?

And that's the volume from the areas you're doing. In the other table in the project, I also need to calculate the total length*height.

Can you do that, too?

Thank you very much, by the way. Excellent work ....

Edited November 20, 2019 by black

[BIGAL]

easy one 1st

change
(setq a (+ a (vlax- (ssname s (setq i (1- i))))))

(setq a (vlax-get (vlax-ename->vla-object (ssname s (setq i (1- i)))) 'Length))

Change words to suit answer. "Vol" 

Picking layers can be done via window problem is multiple answers of same layer name need to sort layers remove duplicates and end up with only 4 layers. Different method of selection, version 2 of program.

 

Pick all objects make a list ((layer length)(layer length)(layer length)…..) sort list ((layer1 length)(layer1 length)(layer2 length)(layer2 length)…..(layer4 length))

 

Then layer length*height total.

 

Need time to do.