简述如下:
API帮助文档的例子ZHeightColors是用VBA写的,它首先通过GetExistingFacets获取当前实体的面片信息,基于此构造Client Graphics,然后沿着实体的包围盒Z方向,最小值位置设置为红色,最高值设置为蓝色,期间的颜色为渐变色。
VBA
Public Sub ZHeightColors() ' Get the surface body from the active document. Dim oPartDoc As PartDocument Set oPartDoc = ThisApplication.ActiveDocument Dim oSurfBody As SurfaceBody Set oSurfBody = oPartDoc.ComponentDefinition.SurfaceBodies.Item(1) Set oSurfBody = oPartDoc.ComponentDefinitions.Item(1).SurfaceBodies.Item(1) ' Delete the graphics data set and client graphics,if they exist. Dim oDataSets As GraphicsDataSets On Error Resume Next Set oDataSets = oPartDoc.GraphicsDataSetsCollection.Item("MyTest") If Err.Number = 0 Then oDataSets.Delete oPartDoc.ComponentDefinition.ClientGraphicsCollection.Item("MyTest").Delete oSurfBody.Visible = True ThisApplication.ActiveView.Update Exit Sub End If On Error GoTo 0 ' Determine the highest tolerance of the existing facet sets. Dim ToleranceCount As Long Dim ExistingTolerances() As Double Call oSurfBody.GetExistingFacetTolerances(ToleranceCount,ExistingTolerances) Dim i As Long Dim BestTolerance As Double For i = 0 To ToleranceCount - 1 If i = 0 Then BestTolerance = ExistingTolerances(i) ElseIf ExistingTolerances(i) < BestTolerance Then BestTolerance = ExistingTolerances(i) End If Next ' Get a set of existing facets. Dim iVertexCount As Long Dim iFacetCount As Long Dim adVertexCoords() As Double Dim adNormalVectors() As Double Dim aiVertexIndices() As Long Call oSurfBody.GetExistingFacets(BestTolerance,iVertexCount,iFacetCount,_ adVertexCoords,adNormalVectors,aiVertexIndices) ' Start a transaction. Dim oTrans As Transaction Set oTrans = ThisApplication.TransactionManager.StartTransaction(oPartDoc,"Z Height Colors") ' Create the graphics data sets collection. Set oDataSets = oPartDoc.GraphicsDataSetsCollection.Add("MyTest") ' Create the coordinate set and set it using the coordinates from the facets. Dim oGraphicsCoordSet As GraphicsCoordinateSet Set oGraphicsCoordSet = oDataSets.CreateCoordinateSet(1) Call oGraphicsCoordSet.PutCoordinates(adVertexCoords) ' Create the index set and set it using the indices from the facets. Dim oGraphicsIndexSet As GraphicsIndexSet Set oGraphicsIndexSet = oDataSets.CreateIndexSet(2) Call oGraphicsIndexSet.PutIndices(aiVertexIndices) ' Create the normal set and set it using the normals from the facets. Dim oGraphicsNormalSet As GraphicsNormalSet Set oGraphicsNormalSet = oDataSets.CreateNormalSet(3) Call oGraphicsNormalSet.PutNormals(adNormalVectors) ' Determine the min-max range of the body in Z. Dim dMinZ As Double dMinZ = oSurfBody.RangeBox.MinPoint.Z Dim dMaxZ As Double dMaxZ = oSurfBody.RangeBox.MaxPoint.Z Dim dHeightDifference As Double dHeightDifference = dMaxZ - dMinZ ' Allocate the array that will contain the color information. ' This array contains RGB values for each vertex. Dim abtColors() As Byte ReDim abtColors(0 To iVertexCount * 3 - 1) As Byte ' Load the array with color information for each vertex. For i = 0 To iVertexCount - 1 ' Get the Z height of the current vertex. Dim dZValue As Double dZValue = adVertexCoords(i * 3 + 2) ' Set the color information for the current vertex. It's computed by ' determining the percentage of the total Z range of the body this vertex ' is within. A color between red and blue is computed based on this percentage. ' Blue is at the minimum Z and Red is at the maximum Z with blending between. abtColors(i * 3) = ((dZValue - dMinZ) / dHeightDifference) * 255 abtColors(i * 3 + 1) = 0 abtColors(i * 3 + 2) = ((dMaxZ - dZValue) / dHeightDifference) * 255 Next ' Create the color set and set it using the array of rgb values just created. Dim oGraphicsColorSet As GraphicsColorSet Set oGraphicsColorSet = oDataSets.CreateColorSet(4) Call oGraphicsColorSet.PutColors(abtColors) ' Create the client graphics collection. Dim oClientGraphics As ClientGraphics Set oClientGraphics = oPartDoc.ComponentDefinition.ClientGraphicsCollection.Add("MyTest") ' Create a graphics node. Dim oGraphicNode As GraphicsNode Set oGraphicNode = oClientGraphics.AddNode(1) ' Create the triangle graphics. Dim oTriangles As TriangleGraphics Set oTriangles = oGraphicNode.AddTriangleGraphics ' Set varIoUs prroperties of the triangle graphics. oTriangles.CoordinateSet = oGraphicsCoordSet oTriangles.CoordinateIndexSet = oGraphicsIndexSet oTriangles.NormalSet = oGraphicsNormalSet oTriangles.NormalBinding = kPerVertexNormals oTriangles.NormalIndexSet = oGraphicsIndexSet oTriangles.ColorSet = oGraphicsColorSet oTriangles.ColorBinding = kPerVertexColors oTriangles.ColorIndexSet = oGraphicsIndexSet ' Turn off the display of the body. oSurfBody.Visible = False ' End the transaction. oTrans.End ' Update the view. ThisApplication.ActiveView.Update End Sub
将此段代码贴到VB.NET,调整一些语法错误,编译通过。运行会发现GetExistingFacets 失败。这是为什么呢?
1. 首先是在.NET 中定义COM的整型数组,需要用Integers. MSDN是这样说的
If you are interfacing with components not written for the .NET Framework,for example Automation or COM objects,keep in mind that Long has a different data width (32 bits) in other environments. If you are passing a 32-bit argument to such a component,declare it as Integer instead of Long in your new Visual Basic code.
2. 注意数组以0为起始序号,而很多VBA的数组定义为:
Dim stuff(1 to 10) As Double
3. VB.NET中需要对数组初始化,而不能只是定义。例如
Dim adVertexCoords() As Double
需要变成
Dim adVertexCoords() As Double = {}
基于这些注意事项,以上的VBA代码修改如下后,就能成功运行了。
VB.NET
Public Sub ZHeightColors() ' Get the surface body from the active document. Dim oPartDoc As PartDocument oPartDoc = m_invApp.ActiveDocument Dim oSurfBody As SurfaceBody oSurfBody = oPartDoc.ComponentDefinition.SurfaceBodies.Item(1) oSurfBody = oPartDoc.ComponentDefinitions.Item(1).SurfaceBodies.Item(1) ' Delete the graphics data set and client graphics,if they exist. Dim oDataSets As GraphicsDataSets On Error Resume Next oDataSets = oPartDoc.GraphicsDataSetsCollection.Item("MyTest") If Err.Number = 0 Then oDataSets.Delete() oPartDoc.ComponentDefinition.ClientGraphicsCollection.Item("MyTest").Delete() oSurfBody.Visible = True m_invApp.ActiveView.Update() Exit Sub End If On Error GoTo 0 ' Determine the highest tolerance of the existing facet sets. Dim ToleranceCount As Integer Dim ExistingTolerances() As Double = {} Call oSurfBody.GetExistingFacetTolerances(ToleranceCount,ExistingTolerances) Dim i As Integer Dim BestTolerance As Double For i = 0 To ToleranceCount - 1 If i = 0 Then BestTolerance = ExistingTolerances(i) ElseIf ExistingTolerances(i) < BestTolerance Then BestTolerance = ExistingTolerances(i) End If Next ' Get a set of existing facets. Dim iVertexCount As Integer Dim iFacetCount As Integer Dim adVertexCoords() As Double = {} Dim adNormalVectors() As Double = {} Dim aiVertexIndices() As Integer = {} Call oSurfBody.GetExistingFacets(BestTolerance,_ adVertexCoords,aiVertexIndices) ' Start a transaction. Dim oTrans As Transaction oTrans = m_invApp.TransactionManager.StartTransaction(oPartDoc,"Z Height Colors") ' Create the graphics data sets collection. oDataSets = oPartDoc.GraphicsDataSetsCollection.Add("MyTest") ' Create the coordinate set and set it using the coordinates from the facets. Dim oGraphicsCoordSet As GraphicsCoordinateSet oGraphicsCoordSet = oDataSets.CreateCoordinateSet(1) Call oGraphicsCoordSet.PutCoordinates(adVertexCoords) ' Create the index set and set it using the indices from the facets. Dim oGraphicsIndexSet As GraphicsIndexSet oGraphicsIndexSet = oDataSets.CreateIndexSet(2) Call oGraphicsIndexSet.PutIndices(aiVertexIndices) ' Create the normal set and set it using the normals from the facets. Dim oGraphicsNormalSet As GraphicsNormalSet oGraphicsNormalSet = oDataSets.CreateNormalSet(3) Call oGraphicsNormalSet.PutNormals(adNormalVectors) ' Determine the min-max range of the body in Z. Dim dMinZ As Double dMinZ = oSurfBody.RangeBox.MinPoint.Z Dim dMaxZ As Double dMaxZ = oSurfBody.RangeBox.MaxPoint.Z Dim dHeightDifference As Double dHeightDifference = dMaxZ - dMinZ ' Allocate the array that will contain the color information. ' This array contains RGB values for each vertex. Dim abtColors() As Byte ReDim abtColors(iVertexCount * 3 - 1) ' Load the array with color information for each vertex. For i = 0 To iVertexCount - 1 ' Get the Z height of the current vertex. Dim dZValue As Double dZValue = adVertexCoords(i * 3 + 2) ' Set the color information for the current vertex. It's computed by ' determining the percentage of the total Z range of the body this vertex ' is within. A color between red and blue is computed based on this percentage. ' Blue is at the minimum Z and Red is at the maximum Z with blending between. abtColors(i * 3) = ((dZValue - dMinZ) / dHeightDifference) * 255 abtColors(i * 3 + 1) = 0 abtColors(i * 3 + 2) = ((dMaxZ - dZValue) / dHeightDifference) * 255 Next ' Create the color set and set it using the array of rgb values just created. Dim oGraphicsColorSet As GraphicsColorSet oGraphicsColorSet = oDataSets.CreateColorSet(4) Call oGraphicsColorSet.PutColors(abtColors) ' Create the client graphics collection. Dim oClientGraphics As ClientGraphics oClientGraphics = oPartDoc.ComponentDefinition.ClientGraphicsCollection.Add("MyTest") ' Create a graphics node. Dim oGraphicNode As GraphicsNode oGraphicNode = oClientGraphics.AddNode(1) ' Create the triangle graphics. Dim oTriangles As TriangleGraphics oTriangles = oGraphicNode.AddTriangleGraphics ' Set varIoUs prroperties of the triangle graphics. oTriangles.CoordinateSet = oGraphicsCoordSet oTriangles.CoordinateIndexSet = oGraphicsIndexSet oTriangles.NormalSet = oGraphicsNormalSet oTriangles.NormalBinding = NormalBindingEnum.kPerVertexNormals oTriangles.NormalIndexSet = oGraphicsIndexSet oTriangles.ColorSet = oGraphicsColorSet oTriangles.ColorBinding = ColorBindingEnum.kPerVertexColors oTriangles.ColorIndexSet = oGraphicsIndexSet ' Turn off the display of the body. oSurfBody.Visible = False ' End the transaction. oTrans.End() ' Update the view. m_invApp.ActiveView.Update() End Sub原文链接:https://www.f2er.com/vb/258716.html