Author Topic: List of object properties to an array?  (Read 21760 times)

0 Members and 1 Guest are viewing this topic.

mkweaver

  • Bull Frog
  • Posts: 352
List of object properties to an array?
« on: November 08, 2007, 02:33:06 PM »
I would like to get a list of all the properties for an object into an array.  Is there any way to do this with VBA?

Specifically, I want to get all of the properties for a layer along with the values so I can store them or copy them to another drawing.  I don't want to specify the properties because I want the code to accept new properties as they are added to the object model.

All suggestions welcome,

Mike Weaver

Bob Wahr

  • Guest
Re: List of object properties to an array?
« Reply #1 on: November 08, 2007, 02:43:47 PM »
I don't think it's possible.  I would really love to be proven wrong on this, just because it will be cool to see though.

mkweaver

  • Bull Frog
  • Posts: 352
Re: List of object properties to an array?
« Reply #2 on: November 08, 2007, 02:57:16 PM »
MSDN has an article http://msdn.microsoft.com/msdnmag/issues/1200/TypeLib/default.aspx that explains how to do it using tlbinf32.dll, but I was hoping there was something built into vba.

Mike

T.Willey

  • Needs a day job
  • Posts: 5251
Re: List of object properties to an array?
« Reply #3 on: November 08, 2007, 05:11:11 PM »
Can be done with Lisp.  Look at the 'atoms-family' function.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

mkweaver

  • Bull Frog
  • Posts: 352
Re: List of object properties to an array?
« Reply #4 on: November 08, 2007, 07:03:03 PM »
Tim,
The only way I can see to possibly get a list of object properties with Atoms-Family is to check each member of Atoms-Family against my object to see if it is a property of that object using vlax-property-available-p.  Is this what you had in mind, or is there another way I'm missing?

Mike Weaver

T.Willey

  • Needs a day job
  • Posts: 5251
Re: List of object properties to an array?
« Reply #5 on: November 08, 2007, 07:31:26 PM »
Tim,
The only way I can see to possibly get a list of object properties with Atoms-Family is to check each member of Atoms-Family against my object to see if it is a property of that object using vlax-property-available-p.  Is this what you had in mind, or is there another way I'm missing?

Mike Weaver
That is the way I was thinking, and how it was shown to me my MP (from here).  I don't know of any other way Mike.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Glenn R

  • Guest
Re: List of object properties to an array?
« Reply #6 on: November 08, 2007, 08:51:52 PM »
Clone it using an AxDbDocument and ThisDrawing.CopyObjects from memory.

SomeCallMeDave

  • Guest
Re: List of object properties to an array?
« Reply #7 on: November 08, 2007, 09:40:09 PM »
MSDN has an article http://msdn.microsoft.com/msdnmag/issues/1200/TypeLib/default.aspx that explains how to do it using tlbinf32.dll, but I was hoping there was something built into vba.

Mike

Using info from above link, this code (as ugly and kludgy as it may be) will return a collection filled with properties of a desired Autocad entity

Code: [Select]
Function BestClassInfo(ByVal Object As Object) As TypeInfo
  Set BestClassInfo = TLI.ClassInfoFromObject(Object)
  On Error GoTo NotAvailable
  With BestClassInfo.Parent
    With TLI.TypeLibInfoFromRegistry _
         (.GUID, .MajorVersion, .MinorVersion, .LCID)
      Set BestClassInfo = .Me.TypeInfos.IndexedItem(BestClassInfo.TypeInfoNumber)
    End With
  End With
  Exit Function
NotAvailable:
  Err.Clear
End Function

Function ImplementedInterfaces( _
  ByVal ccInfo As CoClassInfo, _
  Libs As Collection, _
  Optional ByVal fIncludeDefault As Boolean = True) As SearchResults
Dim SR As SearchResults
Dim IFace As InterfaceInfo
Dim TLInf As TypeLibInfo
Dim TLInfLast As TypeLibInfo
Dim strKey As String
Dim TypeInfos(0) As Integer
Dim tinfoDefault As IUnknown
Dim fLookupLib As Boolean
  Set Libs = New Collection
  If Not fIncludeDefault Then
    Set tinfoDefault = ccInfo.DefaultInterface.ITypeInfo
  End If
  On Error GoTo Error
  For Each IFace In ccInfo.Interfaces
    If 0 = (IFace.AttributeMask And _
            (IMPLTYPEFLAG_FSOURCE Or IMPLTYPEFLAG_FRESTRICTED)) Then
      If Not fIncludeDefault Then
        If tinfoDefault Is IFace.ITypeInfo Then
          'Turn off default check once we find it
          fIncludeDefault = True
          GoTo DoNext
        End If
      End If
      Set TLInf = IFace.Parent
      TypeInfos(0) = IFace.TypeInfoNumber
      fLookupLib = True
      If TLInfLast Is Nothing Then
      ElseIf TLInf.IsSameLibrary(TLInfLast) Then
        'TLInfLast is simply an optimization.
        'Checking IsSameLibrary is faster than
        'doing a collection lookup.
        fLookupLib = False
        'Use the TypeLibInfo object from the
        'collection so that it has the LibNum set
        Set TLInf = TLInfLast
      End If
If fLookupLib Then
        strKey = CStr(ObjPtr(TLInf.ITypeLib))
        On Error Resume Next
        'Use the TypeLibInfo object from the
        'collection so that it has the LibNum set
        Set TLInf = Libs(strKey)
        If Err Then
          'New library
          TLInf.LibNum = Libs.Count + 1
          Libs.Add TLInf, strKey
          Set TLInfLast = TLInf
        End If
        On Error GoTo Error
      End If
      'Call AddTypes, appending to the previous collection
      Set ImplementedInterfaces = _
       TLInf.AddTypes(TypeInfos, ImplementedInterfaces, , False)
    End If
DoNext:
  Next
  Exit Function
Error:
  Resume DoNext
End Function



Public Function ExtractProperties(pEntTypeName As String) As Collection


'Calling Code
Dim TLInf As TypeLibInfo
Dim SR As SearchResults
Dim SI As SearchItem
Dim Libs As Collection
Dim SRMembers As SearchResults
Dim ccInfo As CoClassInfo
Dim xCoInfo1 As CoClassInfo
Dim xCoInfo2 As CoClassInfo
Dim xTLInfo3 As TypeLibInfo
Dim myCoClasses As CoClasses
Dim strEntType As String
Dim oMyObj As Object
Dim i As Integer
Dim myTypeInfo As TypeInfo
Dim PropList() As String
Dim myInterfaceInfo As InterfaceInfo
Dim PropCollection As Collection



strEntType = "AcadCircle"
Set ccInfo = BestClassInfo(ThisDrawing)

Set SR = ImplementedInterfaces(ccInfo, Libs)
If Not SR Is Nothing Then
  SR.Sort
  For Each SI In SR
    'Do a set first to avoid late bound calls
    'against TLI objects
    Set TLInf = Libs(SI.LibNum)
    Set SRMembers = TLInf.GetMembers(SI.SearchData)
    'Process members
  Next
End If

Set myCoClasses = Libs.Item(1).CoClasses


For i = 1 To myCoClasses.Count

  Set xCoInfo1 = myCoClasses(i)
  If xCoInfo1.Name = pEntTypeName Then
     Set xCoInfo2 = xCoInfo1
     Set myTypeInfo = TLInf.GetTypeInfo(xCoInfo2.TypeInfoNumber)
  End If
  Set xCoInfo1 = Nothing
Next

Set myInterfaceInfo = xCoInfo2.Interfaces(1)

ReDim PropList(1 To myInterfaceInfo.Members.Count)

Set PropCollection = New Collection

For i = 1 To myInterfaceInfo.Members.Count
    PropList(i) = myInterfaceInfo.Members(i).Name
    If myInterfaceInfo.Members(i).InvokeKind = INVOKE_PROPERTYGET Then
       PropCollection.Add myInterfaceInfo.Members(i).Name
    End If
Next i

Set ExtractProperties = PropCollection


End Function


' ********this is the callable code  ************
Public Sub TestExtract()

  Dim colProperties As Collection
 
  Set colProperties = New Collection
 
  Set colProperties = ExtractProperties("AcadCircle")  ' put your desire entity here

End Sub



Most of the code comes from the Help file for Type Lib Information Library.
Your VBA project must include a reference to TypeLineInformation (tlbinf32.dll)

Have fun  :)

The result are in the attached image

mkweaver

  • Bull Frog
  • Posts: 352
Re: List of object properties to an array?
« Reply #8 on: November 08, 2007, 10:01:40 PM »

Tim,
The only way I can see to possibly get a list of object properties with Atoms-Family is to check each member of Atoms-Family against my object to see if it is a property of that object using vlax-property-available-p.  Is this what you had in mind, or is there another way I'm missing?

Mike Weaver
That is the way I was thinking, and how it was shown to me my MP (from here).  I don't know of any other way Mike.

With Layer set to a layer object, I get the following:
Code: [Select]
(setq temp (vl-remove-if-not (function (lambda(var)
(vlax-property-available-p layer var))) (atoms-family 0)))
(LAYERON)
Not quite what I was expecting

SomeCallMeDave

  • Guest
Re: List of object properties to an array?
« Reply #9 on: November 08, 2007, 10:14:59 PM »
OK, forget all that stuff in my previous post.

It gets a WHOLE lot easier.

A reference to TypeLineInformation (tlbinf32.dll) is still needed.

Code: [Select]
Public Sub testGetProps()

    Dim cData As Collection

    Set cData = dkb_GetProperties(ThisDrawing.ModelSpace(0)) 'select your object however suits you best

End Sub

Public Function dkb_GetProperties(pObject As Acad0bject) As Collection
    Dim iInterFaceInfo As InterfaceInfo
    Dim cClassInfo As TypeInfo
   
    Dim colProperties As Collection
    Dim i As Integer
   
    Set colProperties = New Collection
   
    Set iInterFaceInfo = InterfaceInfoFromObject(pObject)

    For i = 1 To iInterFaceInfo.Members.Count
        If iInterFaceInfo.Members(i).InvokeKind = INVOKE_PROPERTYGET Then
            colProperties.Add iInterFaceInfo.Members(i).Name
        End If
    Next i

    Set dkb_GetProperties = colProperties

End Function
« Last Edit: November 08, 2007, 10:16:47 PM by SomeCallMeDave »

SomeCallMeDave

  • Guest
Re: List of object properties to an array?
« Reply #10 on: November 08, 2007, 10:18:20 PM »
Here is the results for a layer

Code: [Select]
Set cData = dkb_GetProperties(ThisDrawing.Layers(0))

mkweaver

  • Bull Frog
  • Posts: 352
Re: List of object properties to an array?
« Reply #11 on: November 08, 2007, 10:42:21 PM »
Here is the results for a layer

Code: [Select]
Set cData = dkb_GetProperties(ThisDrawing.Layers(0))

Very good, Dave!


MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: List of object properties to an array?
« Reply #12 on: November 08, 2007, 10:44:47 PM »
<applause.wav>



(Sorry for the brevity, long day, I'm bagged).
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Bob Wahr

  • Guest
Re: List of object properties to an array?
« Reply #13 on: November 09, 2007, 01:17:26 AM »
Not the first time and it won't be the last but my hat is off to you Dave.

SomeCallMeDave

  • Guest
Re: List of object properties to an array?
« Reply #14 on: November 09, 2007, 07:19:39 AM »
Thanks guys, but all I really did was explore a help file and play with the Locals window in VBA.

tlbinf32.dll is definitely worth investigating.  If I find any more goodies, I will post them.

I'm thinking this might be a good way to find some hidden functions/properties.

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: List of object properties to an array?
« Reply #15 on: November 09, 2007, 10:04:23 AM »
Thanks guys, but all I really did was explore a help file and play with the Locals window in VBA.

Yeah, but it's a gooder!

Something I'm working on for the lispin' folks --

(_GetPropertiesAndMethods (_ObjSel))

Select object: <Michael selects a sphere>

(
    (PROPERTIES

        ("Application" #<VLA-OBJECT IAcadApplication 00d73d3c>)
        ("Centroid" (1568.79 542.192 0.0))
        ("color" 256)
        ("Database" #<VLA-OBJECT IAcadDatabase 0bc1cb6c>)
        ("Document" #<VLA-OBJECT IAcadDocument 0775f300>)
        ("EntityName" "AcDb3dSolid")
        ("EntityType" 3)
        ("Handle" "1AE")
        ("HasExtensionDictionary" 0)
        ("History" -1)
        ("Hyperlinks" #<VLA-OBJECT IAcadHyperlinks 0bc2851c>)
        ("Layer" "0")
        ("Linetype" "ByLayer")
        ("LinetypeScale" 1.0)
        ("Lineweight" -1)
        ("Material" "ByLayer")
        ("MomentOfInertia" (5.97049e+011 4.96199e+012 5.55409e+012))
        ("ObjectID" 2130322288)
        ("ObjectName" "AcDb3dSolid")
        ("OwnerID" 2130316536)
        ("PlotStyleName" "ByLayer")
        ("Position" (1568.79 542.192 0.0))
        ("PrincipalDirections" (1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0))
        ("PrincipalMoments" (4.94487e+009 4.94487e+009 4.94487e+009))
        ("ProductOfInertia" (1.71321e+012 0.0 0.0))
        ("RadiiOfGyration" (544.451 1569.57 1660.58))
        ("ShowHistory" 0)   
        ("SolidType" "Sphere")
        ("TrueColor" #<VLA-OBJECT IAcadAcCmColor 0bb8c3d0>)
        ("Visible" -1)
        ("Volume" 2.01415e+006)
   
    )
   
    (METHODS
   
        ;;  The number is the argument count. The next version will actually
        ;;  name the arguments and spec the data type. Ha ha ha ha ha ha.

        ("AddRef" 0)
        ("ArrayPolar" 3)
        ("ArrayRectangular" 6)
        ("Boolean" 2)
        ("CheckInterference" 2)
        ("color" 0)
        ("Copy" 0)
        ("Delete" 0)
        ("Erase" 0)
        ("GetBoundingBox" 2)
        ("GetExtensionDictionary" 0)
        ("GetIDsOfNames" 5)
        ("GetTypeInfo" 3)
        ("GetTypeInfoCount" 1)
        ("GetXData" 3)
        ("Highlight" 1)
        ("History" 0)
        ("IntersectWith" 2)
        ("Invoke" 8)
        ("Layer" 0)
        ("Linetype" 0)
        ("LinetypeScale" 0)
        ("Lineweight" 0)
        ("Material" 0)
        ("Mirror" 2)
        ("Mirror3D" 3)
        ("Move" 2)
        ("PlotStyleName" 0)
        ("Position" 0)
        ("QueryInterface" 2)
        ("Release" 0)
        ("Rotate" 2)
        ("Rotate3D" 3)
        ("ScaleEntity" 2)
        ("SectionSolid" 3)
        ("SetXData" 2)
        ("ShowHistory" 0)
        ("SliceSolid" 4)
        ("TransformBy" 1)
        ("TrueColor" 0)
        ("Update" 0)
        ("Visible" 0)

    )
   
)


Michael wanders off laughing maniacally looking for a life ...
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

FengK

  • Guest
Re: List of object properties to an array?
« Reply #16 on: March 26, 2008, 03:23:40 PM »
In case someone else can make use of it.

Code: [Select]
;;;=================================================================================
;;; 1. You need to register tlbinf32.dll before using these functions.
;;; 2. Thanks to Michael Puckett and David Blackmon for sharing their findings about
;;;    using tlbinf32.dll. Sorry if I missed anyone that should be credited.
;;; 3. Feel free to modify/use.
;;;=================================================================================

;;;Enum InvokeKinds
;;;  INVOKE_UNKNOWN = 0,
;;;  INVOKE_FUNC = 1,
;;;  INVOKE_PROPERTYGET = 2,
;;;  INVOKE_PROPERTYPUT = 4,
;;;  INVOKE_PROPERTYPUTREF = 8,
;;;  'Special TLI values
;;;  INVOKE_EVENTFUNC = 16,
;;;  INVOKE_CONST = 32
;;;End Enum

;;;=================================================================================
;;;(KF:Get_Object_TypeInfo
;;;  (car (entsel "\nPick object to list TypeInfo: "))
;;;)
(defun KF:Get_Object_TypeInfo (obj / appTli lstInvokeKind rv objInfo @)
  (if (setq appTli (vlax-create-object "TLI.TLIApplication"))
    (progn
      (if (eq 'ENAME (type obj))
(setq obj (vlax-ename->vla-object obj))
      )
      (setq lstInvokeKind (list 0 1 2 4 8 16 32)
    rv   (mapcar 'list lstInvokeKind)
      )
      (setq objInfo (vlax-invoke appTli 'InterfaceInfoFromObject obj))
      (vlax-for infoMember (vlax-get-property objInfo 'Members)
(setq @   (vl-position
    (vlax-get-property infoMember 'InvokeKind)
    lstInvokeKind
  )
      lst (nth @ rv)
      rv  (subst
    (cons (vlax-get-property infoMember 'Name) lst)
    lst
    rv
  )
)
      )
      (mapcar (function (lambda (lst)
  (cons (car lst) (vl-sort (cdr lst) '<))
)
      )
      (mapcar 'reverse rv)
      )
    )
  )
)

;;;=================================================================================
;;;(KF:Get_Object_PropertiesGet
;;;  (car (entsel "\nPick object to list applicable properties to get: "))
;;;)
(defun KF:Get_Object_PropertiesGet (obj / lst)
  (if (setq lst (KF:Get_Object_TypeInfo obj))
    (cdr (nth 2 lst))
  )
)

;;;=================================================================================
;;;(KF:Get_Object_PropertiesPut
;;;  (car (entsel "\nPick object to list applicable properties to put: "))
;;;)
(defun KF:Get_Object_PropertiesPut (obj / lst)
  (if (setq lst (KF:Get_Object_TypeInfo obj))
    (cdr (nth 3 lst))
  )
)

;;;=================================================================================
;;;(KF:Get_Object_Methods
;;;  (car (entsel "\nPick object to list applicable methods: "))
;;;)
(defun KF:Get_Object_Methods (obj / lst)
  (if (setq lst (KF:Get_Object_TypeInfo obj))
    (cdr (nth 1 lst))
  )
)

« Last Edit: March 26, 2008, 07:30:42 PM by Kelie »

taner

  • Guest
Re: List of object properties to an array?
« Reply #17 on: July 19, 2009, 02:32:43 AM »
Dear Sir,

Can you write a progress as KF:Get_Object_PropertiesGet_readonly(get the Properties list that is read-only).

Thanks!

FengK

  • Guest
Re: List of object properties to an array?
« Reply #18 on: July 19, 2009, 04:21:32 AM »
Try this:

Code: [Select]
(defun KF:Get_Object_PropertiesGet_ReadOnly (obj)
  (vl-remove-if (function (lambda (e)
    (member e (KF:Get_Object_PropertiesPut obj))
  )
)
(KF:Get_Object_PropertiesGet obj)
  )
)

chlh_jd

  • Guest
Re: List of object properties to an array?
« Reply #19 on: October 14, 2014, 08:14:17 AM »
Thanks xycadd for share it . :-D

mailmaverick

  • Bull Frog
  • Posts: 494
Re: List of object properties to an array?
« Reply #20 on: November 16, 2014, 11:23:40 PM »
Code: [Select]

;;; 1. You need to register tlbinf32.dll before using these functions.


How to register tlbinf32.dll in AUTOCAD ?
I have searched this file and it exists in C:\Program Files (x86)\VectorDraw\Components\1036\Ansi folder.