Code Red > AutoLISP (Vanilla / Visual)
lisp to make custom data extraction
BIGAL:
I have another request almost the same so I am going to write a global routine 1st, the only difference is that the layer is associated with a type answer, A=area, L=Length, Q=quatity.
Then I dont have to write it twice.
so
layername,L
Blkname,Q
layername,A and plines.
I will though do the Pipes seperate as the answer is divide by 2. A mline may be more useful as the ends can be open but returns only 1 length.
Mostafa Hisham:
Okay sir...
It's great to save your time and effort...
I need already to devide lines length by 2 and to convert its unit from millimeter to meter devide it by 1000
Finally can you devide it by 2000
And can you make it nearest to 0.50 meter?
BIGAL:
Try this very much a custom routine.
--- Code: ---; http://www.theswamp.org/index.php?topic=57012.0
; uses block02
; Make a count of common items
; By AlanH Aug 2021
; By Gile
(defun my-count (a L)
(cond
((null L) 0)
((equal a (car L)) (+ 1 (my-count a (cdr L))))
(t (my-count a (cdr L))))
)
; By Gile
(defun remove_doubles (lst)
(if lst
(cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
)
)
(defun c:mostafa ( / ss laylist)
(setq laylist (list "(MAIN)*" "SECONDARY*" "BEAM*" "SLAB*"))
(setq sp (vlax-3d-point (getpoint "pick a point for table ")))
(Setq vgms (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq numrows 3)
(setq numcolumns 11)
(setq rowheight 17)
(setq colwidth 45)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
;(vla-SetTextHeight Objtable 'acDataRow 15)
(vla-settext objtable 0 0 "QUANTITIES")
(vla-settext objtable 1 0 "LAYER")
(vla-settext objtable 1 1 "NAME")
(vla-settext objtable 1 2 "COUNT")
(vla-settext objtable 1 3 "LENGTH")
(vla-settext objtable 1 4 "AREA")
(vla-settext objtable 1 5 "01-TOC")
(vla-settext objtable 1 6 "02-H")
(vla-settext objtable 1 7 "03-FLOOR")
(vla-settext objtable 1 8 "04-Client")
(vla-settext objtable 1 9 "05-PROJECT")
(vla-settext objtable 1 10 "06-BRANCH")
(vla-Setcolumnwidth Objtable 0 160)
(vla-Setcolumnwidth Objtable 1 270)
(vla-Setcolumnwidth Objtable 1 100)
(vla-Setcolumnwidth Objtable 1 100)
(vla-Setcolumnwidth Objtable 1 270)
(setq Objtable (vlax-ename->vla-object (entlast)))
(setq numrows 2)
(foreach lay laylist
(setq lst '() lst3 '())
(setq ss (ssget "X" (list (cons 0 "INSERT")(cons 8 lay)(cons 410 (getvar 'ctab)))))
(if (= ss nil)
(alert (strcat "no Blocks found on layer " lay))
(progn
(repeat (setq x (sslength ss))
(setq ent (entget (ssname ss (setq x (1- x)))))
(setq bname (cdr (assoc 2 ent)))
(setq lname (cdr (assoc 8 ent)))
(setq lst (cons (list bname) lst))
)
(setq lst2 (remove_doubles lst))
(foreach val lst2
(setq cnt (my-count val lst))
(setq lst3 (cons (list lname (nth 0 val) cnt) lst3))
)
(foreach val lst3
(vla-Settext Objtable numrows 0 (nth 0 val) )
(vla-Settext Objtable numrows 1 (nth 1 val) )
(vla-Settext Objtable numrows 2 (nth 2 val) )
(vla-Settext Objtable numrows 5 "+5.2")
(vla-Settext Objtable numrows 6 "5.2")
(vla-Settext Objtable numrows 7 "Ground")
(vla-Settext Objtable numrows 8 "NASR" )
(vla-Settext Objtable numrows 9 "MIDOR")
(vla-Settext Objtable numrows 10 "South" )
(setq numrows (1+ numrows))
(vla-InsertRows Objtable numrows (vla-GetRowHeight Objtable (1- numrows)) 1)
)
(vla-Settext Objtable numrows 0 "Client" )
(vla-Settext Objtable numrows 1 "Polyline" )
(setq numrows (1+ numrows))
(vla-InsertRows Objtable numrows (vla-GetRowHeight Objtable (1- numrows)) 1)
)
)
)
(setq Objtable (vlax-ename->vla-object (entlast)))
(setq lst '() lst3 '())
(setq ss (ssget "X" (list (cons 0 "LINE")(cons 8 "Tubes")(cons 410 (getvar 'ctab)))))
(if (= ss nil)
(alert "no tubes found")
(progn
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
(setq len (/ (vla-get-length obj) 1000.0))
(setq lst (cons len lst))
)
(setq lst2 (remove_doubles lst))
`
(foreach val lst2
(setq cnt (my-count val lst))
(setq lst3 (cons (list (/ cnt 2) val )lst3))
)
(vla-put-regeneratetablesuppressed Objtable :vlax-true)
(vla-Settext Objtable numrows 0 "Client" )
(vla-Settext Objtable numrows 1 "Polyline" )
(foreach cell lst3
(vla-Settext Objtable numrows 0 "Tubes" )
(vla-Settext Objtable numrows 1 "Line" )
(vla-Settext Objtable numrows 2 (nth 0 cell) )
(vla-Settext Objtable numrows 3 (rtos (nth 1 cell) 2 1))
(vla-Settext Objtable numrows 5 "+5.2")
(vla-Settext Objtable numrows 6 "5.2")
(vla-Settext Objtable numrows 7 "Ground")
(vla-Settext Objtable numrows 8 "NASR" )
(vla-Settext Objtable numrows 9 "MIDOR")
(vla-Settext Objtable numrows 10 "South" )
(setq numrows (1+ numrows))
(vla-InsertRows Objtable numrows (vla-GetRowHeight Objtable (1- numrows)) 1)
)
(vla-put-regeneratetablesuppressed Objtable :vlax-false)
)
)
(princ)
)
(c:mostafa )
--- End code ---
Mostafa Hisham:
Thanks sir very much about your great effort
i have some points about that and i need to add them to this lisp
i'll put it in points
1- Please note that columns (1-TOC , 2-H , 3-Floor ,4-Client,5-Project , 6-Branch ) They are variable from drawing to another and i make custom properties and they are fields then i need to make them be taken from properties of drawing not fixed as they be now .....and thanks about that sir :-D i attach an image about that
2-I need tubes length to be Rounding to the largest 0.50 metres and combine rows that have the same value of length and make the count column is sum of number of these tubes that have the same length ....
3-the poly line in client layer the length and area of it not appeared
4-Some layers and objects inside these layers not appeared and that change my quantities
5-I need it to ask me what it select all objects in the drawing or some objects that i can select
6-also i need the table to be updated automatically when i delete some objects from objects that i select or to delete some objects from the drawing if i select all in the drawing option that i said about in note no.(5) ..
7-the last thing is that i need to export the table to excel and make the name of excel file is the name of the drawing
in the last i really happy for your great work but it's notes to make it easier to me ...
thanks very much about that and i wait your new lisp ....
BIGAL:
1 seperate question just google dwgprops lisp
2 Need to add rounding, the length count should be working will check. It finds some tubes as singles in sample dwg
3 This is where customised solutions creep in so a does a fee.
4 See 3.
5 A if and but may be very difficult.
6 Doubtful to be done given table size.
7 Can be done just not in this version.
Navigation
[0] Message Index
[#] Next page
[*] Previous page
Go to full version