TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Mostafa Hisham on September 07, 2021, 12:30:50 PM
-
Hello every one …
I have a video to explain what I need and I'll explain that
I need to make a lisp to custom dx that get the items i need {layer,name,count,lenght,area,toc,....as the video show} arrangement of these items is important
and put the table in the drawing with scale 1000 -because drawing unit is mm- and also the table in an excel sheet with the same name of drawing
can some one help me about that ??
thanks in advance
https://youtu.be/H2Eqnekil5o
-
There is no problem in making custom data extract, the problem is that it will probably be a custom lisp to suit your needs, make a table yes, export to excel yes.
The issue is the rules layer,name,count,lenght,area how big this ends up depends on you. The obvious what objects are to be selected.
People like me are happy to provide solutions but this is sounding like a need to make a donation for some to be written. A fee for service.
If you want 1 type of object a example, then what layers and so on.
(defun c:test ( / obj len area lay)
(if (setq ss (ssget "X" '((0 . "LWPOLYLINE"))))
(progn
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq len (vla-get-length obj))
(setq lay (vla-get-layer obj))
(setq area (vla-get-area obj))
(princ (strcat "\nLayer = " lay " Length = " (rtos len 2 1) " Area = " (rtos area 2 0)))
)
)
)
(princ)
)
-
thanks sir about that....
I have no problem about paying money to get what I want …..
and also i have a lot of ideas to make by lisp to achieve my requires ….
-
Happy to provide some more information about how much time involved in doing a custom extract.
There are many of us who can do custom work.
What is needed is some guide as to what data your trying to export.
eg1
list of layers
Lines, Arcs, plines = length and areas, individual or sum by layer name
eg2
List of hatches = Area, individual or sum by layer name
A sample small dwg and a list of what to export. The dwg will show the industry your in.
-
okay Sir
this is a drawing
here you are the DWG
I Put the table which i need to make like
and arrangement of columns as i make is important
and i want it to be exported to excel and have the same name of the DWG file
and scale the table in auto-cad by 500 for example because my dwg unit is mm
also sort layer column from A to Z
and another request sir ...
in the photo that i attached the values in (TOC-H-FLOOR-CLIENT-PROJECT-BRANCH) columns are constant and repeated in every row can you make it to be written in one row only and don't be repeated ...
Finally thanks for you
-
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.
-
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?
-
Try this very much a custom routine.
; 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 )
-
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 ....
-
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.
-
okay sir let's talk about these last points
about (1) i want the lisp extract the custom prop not to use another lisp also i need to compact them in one lisp ...
about (2) i make aligned multi lines that make length of line not equal to the another line but i need the lisp to make round to largest 0.50 m first then combine the rows that have the same length and sum the count of them and divide them by 2 to get the number of poly lines not number of exploded lines
about (3) and (4) let's agree on the fees now
about (5) and (6) please try to make that it's very important to me , dx command can make these options can you try to make dx and select these options by programming codes ??
about (7) which version can we make that ?? , i have auto-cad 2022
-
7 Google export table to excel Autocad Lisp
Will try to look at other items today. Will do what is easy.
-
okay thanks sir
i want the lisp to make all of these commands included taking the custom properties and also exporting table to excel
i need you to write the code of all of that in one lisp to save time and effort ....
-
Hello sir
is there any good news about our lisp ??
-
Been busy doing real work will try to add some more features soon.
-
okay i'm waiting for your great work