Jump to content

VBA - Get all properties for the entities the drawing


katto01
 Share

Recommended Posts


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

Link to comment
Share on other sites

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 by PeterPan9720
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

 

 

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...