简述如下:
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, iVertexCount, iFacetCount, _
adVertexCoords, adNormalVectors, 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