VBA - Get all properties for the entities the drawing

[katto01]

Hello,

I am trying to get all the properties of all objects in a drawing. 
In the code attached, I was able to get most of the properties except  the most important ones
the circle, startpoint and endpoint coordinates.
Any ideas?

 

Thank you
 

zwcad_get-all_properties_code.txt

[PeterPan9720]

Hi,

I didnt open the code but what do you mean with starting and end point circle coordinate? I know you can get center point, diameter but I don't know about starting and ending point.

See for example link 

https://www.engram9.info/autocad-2006-vba/acadcircle-object-properties.html

 

Edited September 23, 2022 by PeterPan9720

[PeterPan9720]

Sorry to reply again, please could you share the structure ZcadEntity ?

Thank you

[katto01]

please see attached

what I need is to get the same full information about all the entities in the dwg

20220920_1134_End_Tapered_wire_Helix_with_parasitic_element.dwg

[PeterPan9720]

Thank you for file but I asked for right variable type mentioned in the code not for the dwg.

In any case please check the complete code because what has been attached it's not working as it is. Some parts are mussing.

[BIGAL]

Something like this maybe

 

;;;===================================================================; 
;;; DumpIt                                                            ; 
;;;-------------------------------------------------------------------; 
;;; Dump all methods and properties for selected objects              ; 
;;;===================================================================; 
(defun C:Dumpit ( / ent) 
  (while (setq ent (entsel)) 
    (vlax-Dump-Object 
      (vlax-Ename->Vla-Object (car ent)) 
    ) 
  ) 
  (princ) 
)

Or

 

(entget (car (entsel "\nPick object")))

 

Oh yeah text file is missing a P at start.

[PeterPan9720]

Hi @katto01 Reading the dwg I found arcs not circles as you wrote in your message, so you can try to use the below code specific for arc object. In the same way with <OR> and <AND> function changing the dxf code "Arc" with another object type you can found all objects into the drawing.

Public Sub ArcDetail()

Dim oSS As AcadSelectionSet

Dim oArc As AcadArc

Dim iFilterCode(0) As Integer

Dim vFilterValue(0) As Variant



  On Error Resume Next

  Application.ActiveDocument.SelectionSets("Arcs").Delete

  On Error GoTo 0

  

  Set oSS = Application.ActiveDocument.SelectionSets.Add("Arcs")

  iFilterCode(0) = 0: vFilterValue(0) = "Arc"

  oSS.SelectOnScreen iFilterCode, vFilterValue

  If oSS.Count Then

    For Each oArc In oSS

      With oArc

        MsgBox "StartPoint: " & .StartPoint(0) & ", " & .StartPoint(1) & ", " & .StartPoint(2) & vbCrLf & _

               "EndPoint  : " & .EndPoint(0) & ", " & .EndPoint(1) & ", " & .EndPoint(2)

      End With

 

[katto01]

On 9/25/2022 at 3:36 AM, PeterPan9720 said:

Hi @katto01 Reading the dwg I found arcs not circles as you wrote in your message, so you can try to use the below code specific for arc object. In the same way with <OR> and <AND> function changing the dxf code "Arc" with another object type you can found all objects into the drawing.

Public Sub ArcDetail()

Dim oSS As AcadSelectionSet

Dim oArc As AcadArc

Dim iFilterCode(0) As Integer

Dim vFilterValue(0) As Variant



  On Error Resume Next

  Application.ActiveDocument.SelectionSets("Arcs").Delete

  On Error GoTo 0

  

  Set oSS = Application.ActiveDocument.SelectionSets.Add("Arcs")

  iFilterCode(0) = 0: vFilterValue(0) = "Arc"

  oSS.SelectOnScreen iFilterCode, vFilterValue

  If oSS.Count Then

    For Each oArc In oSS

      With oArc

        MsgBox "StartPoint: " & .StartPoint(0) & ", " & .StartPoint(1) & ", " & .StartPoint(2) & vbCrLf & _

               "EndPoint  : " & .EndPoint(0) & ", " & .EndPoint(1) & ", " & .EndPoint(2)

      End With

 

thanks will try

[katto01]

can one define a variable as "Type of" and use it in a loop?

 

something like :

dim var as Typeof

For Each ent In ThisDrawing.ModelSpace
        If TypeOf ent Is var Then



dothings

endif

next

 

 

[PeterPan9720]

Hi

TypeOf will be used to check the object type

See  https://forums.autodesk.com/t5/vba/name-of-type-of-entity/td-p/2085403

[PeterPan9720]

This is another example of TypeOf right use.

I never seen a code like shared by you in the post before.

For Each Object In ThisDrawing.ModelSpace
    If TypeOf Object Is AcadBlockReference Or TypeOf Object Is AcadBlock Then
		'DO SOMETHING

 

[BIGAL]

I know you want VBA but this is a lisp that gets properties of an object, the idea is say get a pline then you can choose which properties you want, you can see how each type of object has different properties available.

 

Just a comment VBA can call a lisp, likewise a lisp can run a VBA.

 

; properties use as a library function
; By Alan H july 2020

(defun cords (obj / co-ords xy )
(setq coordsxy '())
(setq co-ords (vlax-get obj 'Coordinates))
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth (+ I 1) co-ords)(nth I co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
)
)


(defun AH:chkcwccw (obj / lst newarea)
(setq lst (CORDS obj))
(setq newarea
(/ (apply (function +)
            (mapcar (function (lambda (x y)
                                (- (* (car x) (cadr y)) (* (car y) (cadr x)))))
                    (cons (last lst) lst)
                    l)) 
2.)
)
(if (< newarea  0)
(setq cw "F")
(setq cw "T")
)
)

; Can use reverse in Autocad - pedit reverse in Bricscad.

(defun plprops (obj lst / )
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vla-get-layer obj)))
((= (strcase val) "AREA")(setq area (vla-get-area obj)))
((= (strcase val) "START")(setq start (vlax-curve-getstartpoint obj)))
((= (strcase val) "END" (strcase txt))(setq end (vlax-curve-getendpoint obj)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Length)))
((= (strcase val) "CW" (strcase txt))(AH:chkcwccw obj))
((= (strcase val) "CORDS" (strcase txt))(CORDS obj))
)
)
)

(defun lineprops (obj lst / )
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "START")(setq start (vlax-get obj 'startpoint)))
((= (strcase val) "END" (strcase txt))(setq end (vlax-get obj 'endpoint)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Length)))
)
)
)

(defun circprops (obj lst / )
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Circumference)))
((= (strcase val) "RAD" (strcase txt))(setq rad (vla-get-radius obj)))
((= (strcase val) "CEN" (strcase txt))(setq cen (vlax-get obj 'Center)))
((= (strcase val) "AREA" (strcase txt))(setq end (vlax-get obj 'AREA)))
)
)
)

(defun arcprops (obj txtlst)
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'length)))
((= (strcase val) "RAD" (strcase txt))(setq rad (vla-get-radius obj)))
((= (strcase val) "CEN" (strcase txt))(setq cen (vlax-get obj 'Center)))
((= (strcase val) "START" (strcase txt))(setq area (vlax-get obj 'startpoint)))
((= (strcase val) "END" (strcase txt))(setq area (vlax-get obj 'endpoint)))
((= (strcase val) "AREA" (strcase txt))(setq end (vlax-get obj 'AREA)))
)
)
)

; starts here
(setq ent (vlax-ename->vla-object (car (entsel "Pick Object "))))
; do a check for object type then use defun
; pick an example below


; many examples copy to command line for testing mix and match 
; (plprops ent '("LAY"))(princ lay)
; (plprops ent '("END"))(princ end)
; (plprops ent '("START"))(princ start)
; (plprops ent '("END" "START"))(princ end)(princ start)
; (plprops ent '("AREA" "LAY" "END" "START"))(princ area)(princ lay)(princ end)(princ start)
; (plprops ent '("START" "AREA" "LAY" "CW"))(princ start)(princ area)(princ cw)
; (plprops ent '("start" "END" "CORDS" "cw"))(princ start)(princ end)(princ coordsxy)(princ cw)
; (plprops ent '("CW"))(princ cw)
; (plprops ent '("AREA"))(princ area)
; (plprops ent '("CORDS"))(princ coordsxy)
; (lineprops ent "len"))(princ len)
; (lineprops ent '("len" "lay"))(princ len)(princ lay)
; (lineprops ent '("lay" "end" "start" "len"))(princ len)(princ lay)(princ start)(princ end)
; (circprops ent '("lay" "rad" "area" "cen"))(princ lay)(princ rad)(princ area)(princ cen)
; (circprops ent '("lay" "rad"))
; (arcprops ent '("lay" "rad"))

 

So like PeterPan9720 you need to create a IF for each object type.