Why Gemfury?
Push, build, and install
RubyGems
npm packages
Python packages
Maven artifacts
PHP packages
Go Modules
Debian packages
RPM packages
NuGet packages
bee
bee / draftsight deb
Repository URL to install this package:
|
Version:
2016.3.0.4050 ▾
|
draftsight
/
opt
/
dassault-systemes
/
DraftSight
/
APISDK
/
Create_Polygon_Face_Mesh_Example_VBA.htm
|
|---|
<html>
<head>
<title>Create Polygon Face Mesh Example (VBA)</title>
<meta http-equiv="Content-Language" content="en-us">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<link rel="stylesheet" type="text/css" href="ApiHelp.css">
<meta name=MS-HKWD content="VBA examples">
<meta name=MS-HKWD content="VBA examples,polygon face meshes">
</head>
<body>
<h1>Create Polygon Face Mesh Example (VBA)</h1>
<p>This example shows how to create a polygon face mesh.</p>
<pre>'--------------------------------------------------------------
' Preconditions:
' 1. Create a VBA macro in a software product in which VBA is
' embedded.
' 2. Copy and paste this example into the Visual Basic IDE.
' 3. Add a reference to the DraftSight type library,
' <i>install_dir</i>\<b>bin\dsAutomation.dll</b>.
' 4. Open the Immediate window.
' 5. Start DraftSight and open a drawing document.
' 6. Run the macro.
'
' Postconditions:
' 1. A polygon face mesh is created and zoomed to fit.
' 2. All polygon mesh face parameters are printed to the Immediate
' window.
'------------------------------------------------------------</pre>
<pre>Option Explicit</pre>
<pre> Sub Main()
</pre>
<pre> 'Connect to DraftSight application
Dim dsApp As DraftSight.Application
Set dsApp = GetObject(, "DraftSight.Application")
'Abort any command currently running in DraftSight
'to avoid nested commands
dsApp.<b>AbortRunningCommand</b></pre>
<pre> 'Get active document
Dim dsDoc As DraftSight.Document
Set dsDoc = dsApp.<b>GetActiveDocument</b>()
If dsDoc Is Nothing Then
MsgBox ("There are no open documents in DraftSight.")
End
End If</pre>
<pre> 'Get model space
Dim dsModel As DraftSight.Model
Set dsModel = dsDoc.<b>GetModel</b>()</pre>
<pre> 'Get Sketch Manager
Dim dsSketchMgr As DraftSight.SketchManager
Set dsSketchMgr = dsModel.<b>GetSketchManager</b>()</pre>
<pre> 'Polygon face mesh parameters
Dim verticesCount As Integer
verticesCount = 8
</pre>
<pre> Dim coordinatesArray() As Variant
coordinatesArray = Array(2#, 2#, 0#, 2#, 6#, 0#, _
6#, 6#, 0#, 6#, 2#, 0#, 2#, 2#, _
2#, 2#, 6#, 2#, 6#, 6#, 2#, 6#, 2#, 2#)
</pre>
<pre> Dim faceVerticesCountArray() As Variant
faceVerticesCountArray = Array(4, 4, 4, 4, 4, 4)
</pre>
<pre> Dim faceVerticesArray() As Variant
faceVerticesArray = Array(1, 2, 3, 4, 5, 6, 7, 8, _
1, 5, 8, 4, 2, 6, 7, 3, 3, 7, 8, _
4, 1, 2, 6, 5)
</pre>
<pre> Dim coordinatesDoubleArray() As Double
Dim i As Long
Dim arraySize As Long
arraySize = UBound(coordinatesArray)
ReDim coordinatesDoubleArray(arraySize)
For i = 0 To arraySize
coordinatesDoubleArray(i) = coordinatesArray(i)
Next i
</pre>
<pre> Dim faceVerticesCountLongArray() As Long
arraySize = UBound(faceVerticesCountArray)
ReDim faceVerticesCountLongArray(arraySize)
For i = 0 To arraySize
faceVerticesCountLongArray(i) = faceVerticesCountArray(i)
Next i
</pre>
<pre> Dim faceVerticesLongArray() As Long
arraySize = UBound(faceVerticesArray)
ReDim faceVerticesLongArray(arraySize)
For i = 0 To arraySize
faceVerticesLongArray(i) = faceVerticesArray(i)
Next i
</pre>
<pre> 'Add polygon face mesh
Dim dsPolyFaceMesh As DraftSight.PolyFaceMesh
Set dsPolyFaceMesh = dsSketchMgr.<b>InsertPolyFaceMesh</b>(verticesCount, coordinatesDoubleArray, faceVerticesCountLongArray, faceVerticesLongArray)</pre>
<pre> If Not dsPolyFaceMesh Is Nothing Then
'Zoom to fit
dsApp.<b>Zoom</b> dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing
</pre>
<pre> 'Print Polygon face mesh properties
PrintParameters dsPolyFaceMesh
Else
MsgBox ("Polygon face mesh entity was not added to the current drawing.")
End If
</pre>
<pre> End Sub</pre>
<pre> Sub PrintParameters(ByVal dsPolyFaceMesh As DraftSight.PolyFaceMesh)
Debug.Print ("Polygon face mesh parameters...")</pre>
<pre> 'Print common entity parameters
Debug.Print ("Handle = " & dsPolyFaceMesh.<b>Handle</b>)
Debug.Print ("Color = " & dsPolyFaceMesh.Color.<b>GetNamedColor</b>())
Debug.Print ("Erased = " & dsPolyFaceMesh.<b>Erased</b>)
Debug.Print ("Layer = " & dsPolyFaceMesh.<b>Layer</b>)
Debug.Print ("LineScale = " & dsPolyFaceMesh.<b>LineScale</b>)
Debug.Print ("LineStyle = " & dsPolyFaceMesh.<b>LineStyle</b>)
Debug.Print ("LineWeight = " & dsPolyFaceMesh.<b>LineWeight</b>)
Debug.Print ("Visible = " & dsPolyFaceMesh.<b>Visible</b>)</pre>
<pre> Dim x1 As Double, y1 As Double, z1 As Double
Dim x2 As Double, y2 As Double, z2 As Double
dsPolyFaceMesh.<b>GetBoundingBox</b> x1, y1, z1, x2, y2, z2
Debug.Print ("BoundingBox: " & x1 & ", " & y1 & ", " & z1 & ", " & x2 & ", " & y2 & ", " & z2)</pre>
<pre> 'Print polygon face mesh faces
Dim countFaces As Long
countFaces = dsPolyFaceMesh.<b>GetFacesCount</b>
Debug.Print ("Count of faces = " & countFaces)
Dim faceIndex As Long
For faceIndex = 0 To dsPolyFaceMesh.<b>GetFacesCount</b>() - 1
Dim corner1Vertex As Long, corner2Vertex As Long, corner3Vertex As Long, corner4Vertex As Long
dsPolyFaceMesh.<b>GetFace</b> faceIndex, corner1Vertex, corner2Vertex, corner3Vertex, corner4Vertex
Debug.Print ("Face(0) : (1),(2),(3),(4) " & faceIndex & " : " & corner1Vertex & ", " & corner2Vertex & ", " & corner3Vertex & ", " & corner4Vertex)</pre>
<pre> Next
</pre>
<pre> 'Print polygon face mesh vertices
Dim countVertices As Long
countVertices = dsPolyFaceMesh.<b>GetVerticesCount</b>
Debug.Print ("Count of vertices = " & countVertices)
Dim vertexIndex As Long
For vertexIndex = 0 To dsPolyFaceMesh.<b>GetVerticesCount</b>() - 1
Dim x As Double, y As Double, z As Double
dsPolyFaceMesh.<b>GetVertexCoordinate</b> vertexIndex, x, y, z
Debug.Print ("Vertex (0) : (1),(2),(3) " & vertexIndex & " : " & x & ", " & y & ", " & z)
Next
</pre>
<pre> End Sub</pre>
<pre>
</pre>
<p> </p>
</body>
</html>