Hi all,
I'm trying to draw a plane using the interactiongraphics and a transientsurfacebody. But I'm getting very strange results. There is a VBA sample of the code I'm using below.
I'm creating a list of points. These points are shown as point graphics, and are in the correct position.
Then I'm creating edges to form a face and creating a transient surfacebody.
Weirdly, the surface is a quarter of the area it should be. I'm printing the start and end points of the edges and they are correct. The surface is simply not correctly created from the inputs. What could be happening here?
Option Explicit
Private Const WIDTH As Double = 20
Private Const HEIGHT As Double = WIDTH
Private app As Application
Private doc As Document
Private compDef As PartComponentDefinition
Private graphicsData As GraphicsDataSets
Private clientGraphics As clientGraphics
Private Nodes As Collection
Private tempNodes As Collection
Sub test()
Dim part As PartDocument
Set part = ThisApplication.ActiveDocument
Dim interactionEvents As interactionEvents
Set interactionEvents = ThisApplication.CommandManager.CreateInteractionEvents()
Dim interactionGraphics As interactionGraphics
Set interactionGraphics = interactionEvents.interactionGraphics
Call Initialize(interactionGraphics, part)
Call AddPlane(part.ComponentDefinition.WorkPlanes.Item(2))
End Sub
Public Sub Initialize(interactionGraphics As interactionGraphics, partDoc As PartDocument)
Set app = ThisApplication
Set doc = partDoc
Set compDef = partDoc.ComponentDefinition
Set graphicsData = interactionGraphics.GraphicsDataSets
Set clientGraphics = interactionGraphics.PreviewClientGraphics
Set Nodes = New Collection
Set tempNodes = New Collection
End Sub
Private Function CreateNewGraphicsNode() As GraphicsNode
Dim ids As Collection
Dim node As GraphicsNode
Dim nodeId As Integer
Dim n As GraphicsNode
Set ids = New Collection
For Each n In clientGraphics
ids.Add n.Id
Next n
nodeId = 1
If ids.count > 0 Then
nodeId = ids.Item(ids.count) + 1
End If
On Error GoTo ErrorHandler
Set node = clientGraphics.AddNode(nodeId)
tempNodes.Add node
Nodes.Add node
Set CreateNewGraphicsNode = node
Exit Function
ErrorHandler:
Err.Raise vbObjectError, , "Failed to add a GraphicsNode. ClientGraphics object might be broken, or node ID is invalid."
End Function
Private Sub AddPointGraphics(node As GraphicsNode, points As Collection)
Dim pointGraphic As PointGraphics
Dim cset As GraphicsCoordinateSet
Dim i As Integer
Dim point As point
Set pointGraphic = node.AddPointGraphics
Set cset = graphicsData.CreateCoordinateSet(1)
pointGraphic.coordinateSet = cset
i = 1
For Each point In points
cset.Add i, point
i = i + 1
Next point
pointGraphic.PointRenderStyle = kCirclePointStyle
End Sub
Private Function GetPoints() As Collection
Dim points As Collection
Dim tg As TransientGeometry
Set points = New Collection
Set tg = app.TransientGeometry
points.Add tg.CreatePoint(-WIDTH / 2, -HEIGHT / 2)
points.Add tg.CreatePoint(-WIDTH / 2, HEIGHT / 2)
points.Add tg.CreatePoint(WIDTH / 2, HEIGHT / 2)
points.Add tg.CreatePoint(WIDTH / 2, -HEIGHT / 2)
Set GetPoints = points
End Function
Private Sub AddSurfaceGraphics(node As GraphicsNode, points As Collection, plane As plane)
Dim bodyDef As SurfaceBodyDefinition
Dim lumpDef As LumpDefinition
Dim faceDef As FaceShellDefinition
Dim face As FaceDefinition
Dim loopDef As EdgeLoopDefinition
Dim i As Integer
Dim j As Integer
Dim p1 As point, p2 As point
Dim lineSegment As lineSegment
Dim v1 As VertexDefinition, v2 As VertexDefinition
Dim edgeDef As EdgeDefinition
Dim body As SurfaceBody
Dim errors As Object
Set bodyDef = app.TransientBRep.CreateSurfaceBodyDefinition
Set lumpDef = bodyDef.LumpDefinitions.Add
Set faceDef = lumpDef.FaceShellDefinitions.Add
Set face = faceDef.FaceDefinitions.Add(plane, True)
Set loopDef = face.EdgeLoopDefinitions.Add
For i = 1 To points.count
j = GetNextIndex(i, points.count)
Set p1 = points(i)
Set p2 = points(j)
Set lineSegment = app.TransientGeometry.CreateLineSegment(p1, p2)
Set v1 = bodyDef.VertexDefinitions.Add(p1)
Set v2 = bodyDef.VertexDefinitions.Add(p2)
Set edgeDef = bodyDef.EdgeDefinitions.Add(v1, v2, lineSegment)
loopDef.EdgeUseDefinitions.Add edgeDef, True
Debug.Print ("Startpoint")
Debug.Print ("X: " + CStr(edgeDef.StartVertex.Position.X))
Debug.Print ("Y: " + CStr(edgeDef.StartVertex.Position.Y))
Debug.Print ("Z: " + CStr(edgeDef.StartVertex.Position.Z))
Debug.Print ("Endpoint")
Debug.Print ("X: " + CStr(edgeDef.EndVertex.Position.X))
Debug.Print ("Y: " + CStr(edgeDef.EndVertex.Position.Y))
Debug.Print ("Z: " + CStr(edgeDef.EndVertex.Position.Z))
Next i
Set body = bodyDef.CreateTransientSurfaceBody(errors)
If Not errors Is Nothing Then
Err.Raise vbObjectError, , "Failed to create the transient face"
End If
Dim surfaceGraphics As surfaceGraphics
Set surfaceGraphics = node.AddSurfaceGraphics(body)
surfaceGraphics.Color = app.TransientObjects.CreateColor(0, 135, 0, 0.2)
End Sub
Private Function GetNextIndex(i As Integer, count As Integer) As Integer
If i = count Then
GetNextIndex = 1
Else
GetNextIndex = i + 1
End If
End Function
Public Function AddPlane(wp As WorkPlane) As GraphicsNode
Dim plane As plane
Dim node As GraphicsNode
Dim points As Collection
Set plane = wp.plane
Set node = CreateNewGraphicsNode()
node.Selectable = True
Set points = GetPoints()
AddPointGraphics node, points
AddSurfaceGraphics node, points, plane
Set AddPlane = node
End Function
