Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
draftsight / opt / dassault-systemes / DraftSight / APISDK / Insert_Shapes_Example_VBA.htm
Size: Mime:
<html>

<head>
<title>Insert Shapes 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,shapes ">
<meta name=MS-HKWD content="VBA examples,Shape Manager ">


</head>


<body>
<h1>Insert Shapes Example (VBA)</h1>

<p>This example shows how to load a shape file and insert the shapes in the 
loaded shape file into a drawing.</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. Start DraftSight and open a document.
' 5. Start debugging the project.
'
' Postconditions:
' 1. Gets the Shape Manager.
' 2. Loads a shape file.
' 3. Gets the shapes in the loaded shape file.
' 4. Inserts the shapes, with an obliquing angle of 30, in the drawing.
' 5. Examine the drawing.
'----------------------------------------------------------------</pre>
<pre>Option Explicit
</pre>
<pre>    Sub Main()</pre>
<pre>        Dim dsApp As DraftSight.Application</pre>
<pre>        'Connect to DraftSight application
        Set dsApp = GetObject(, &quot;DraftSight.Application&quot;)</pre>
<pre>        ' Abort any command currently running in DraftSight to avoid nested commands
        dsApp.<b>AbortRunningCommand</b></pre>
<pre>        If dsApp Is Nothing Then
            Return
        End If</pre>
<pre>        'Get active document
        Dim dsDoc As Document
        Set dsDoc = dsApp.<b>GetActiveDocument</b>()
        If dsDoc Is Nothing Then
            MsgBox (&quot;There are no open documents in DraftSight.&quot;)
            Return
        End If</pre>
<pre>        'Get the Shape Manager
        Dim dsShapeMgr As ShapeManager
        Set dsShapeMgr = dsDoc.<b>GetShapeManager</b>()</pre>
<pre>        'Load shape file LTypeShp.shx
        Dim shapeFileName As String
        shapeFileName = &quot;C:\Program Files\Dassault Systemes\DraftSight\Fonts\LTypeShp.shx&quot;</pre>
<pre>        dsShapeMgr.<b>Load</b> (shapeFileName)</pre>
<pre>        'Get shapes
        Dim shapesStrList As Variant
        shapesStrList = dsShapeMgr.<b>GetAvailableShapes</b>()
        Dim shapesCount As Long
        shapesCount = UBound(shapesStrList)</pre>
<pre>        'Get Sketch Manager
        Dim dsModel As DraftSight.Model
        Dim dsSketchMgr As DraftSight.<b>SketchManager</b>
        Set dsModel = dsDoc.<b>GetModel</b>
        Set dsSketchMgr = dsModel.<b>GetSketchManager</b>()</pre>
<pre>        'Insert shapes
        Dim PositionX As Double
        PositionX = 0#
        Dim PositionY As Double
        PositionY = 0#
        Dim PositionZ As Double
        PositionZ = 0#
        Dim i As Long
        For i = 0 To shapesCount - 1
            Dim dsShape As DraftSight.Shape
            Set dsShape = dsSketchMgr.<b>InsertShape</b>(shapesStrList(i), PositionX, PositionY, PositionZ, 1, 0#)</pre>
<pre>            'Change obliquing property
            Dim angle As Double
            angle = 3.14159265358979 
            dsShape.<b>Obliquing</b> = (30 * angle) / 180</pre>
<pre>            Dim X1 As Double, Y1 As Double, Z1 As Double, X2 As Double, Y2 As Double, Z2 As Double
            dsShape.<b>GetBoundingBox</b> X1, Y1, Z1, X2, Y2, Z2</pre>
<pre>            PositionX = PositionX + (X2 - X1) + 5            </pre>
<pre>        Next        </pre>
<pre>    End Sub</pre>

</body>

</html>