Hide Table of Contents

Fillet and Stretch Sketch Entities Example (VB.NET)

This example shows how to fillet and stretch sketch entities.

'--------------------------------------------------------------
'Preconditions:
' 1. Create a VB.NET Windows console project.
' 2. Copy and paste this project into the VB.NET IDE.
' 3. Add a reference to:
'    install_dir\APISDK\tlb\DraftSight.Interop.dsAutomation.
' 4. Add references to System and System.Windows.Forms.
' 5. Start DraftSight and open a new drawing.
' 6. Run the macro.
'
'Postconditions:
'1. Three pairs of sketch entities are created and filleted.
'2. Three sketch entities are created and stretched.
'----------------------------------------------------------------
Imports System.Collections.Generic
Imports System.Text
Imports DraftSight.Interop.dsAutomation
Imports System.Runtime.InteropServices
Imports System.Windows.Forms

Module Module1
    
Dim dsApp As DraftSight.Interop.dsAutomation.Application
    
Dim dsDoc As Document

    
Sub Main(ByVal args As String())
        
'Connect to DraftSight application
        dsApp = ConnectToDraftSight()
        
If dsApp Is Nothing Then
            Return
        End If
       
       
dsApp.AbortRunningCommand() ' abort any command currently running in DraftSight to avoid nested commands

        'Get active document
        dsDoc = dsApp.GetActiveDocument()
        
If dsDoc Is Nothing Then
            MessageBox.Show("There are no opened documents in DraftSight.")
            
Return
        End If

        'Get model space
        Dim dsModel As Model = dsDoc.GetModel()

        
'Get sketch manager
        Dim dsSketchMgr As SketchManager = dsModel.GetSketchManager()

        
'Fillet entities
        FilletEntities(dsSketchMgr)

        
'Stretch entities
        StretchEntities(dsSketchMgr)
    
End Sub

    Sub StretchEntities(ByVal dsSketchMgr As SketchManager)
        
'Stretch parameters
        Dim displacementX As Double = 4
        
Dim displacementY As Double = 6
        
Dim displacementZ As Double = 0
        
Dim dsEntities As DispatchWrapper() = Nothing
        Dim crossingBoxStartCorner As Double() = Nothing
        Dim crossingBoxEndCorner As Double() = Nothing

        'Prepare entities for stretch
        DrawEntitiesForStretch(dsSketchMgr, dsEntities, crossingBoxStartCorner, crossingBoxEndCorner)

        
'Zoom extents
        dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing)

        MessageBox.Show(
"Entities before STRETCH.")

        
'Stretch entities
        dsSketchMgr.StretchEntities(displacementX, displacementY, displacementZ, dsEntities, crossingBoxStartCorner, crossingBoxEndCorner)

        
'Zoom extents
        dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing)

        MessageBox.Show(
"Entities after STRETCH.")
    
End Sub

    Sub DrawEntitiesForStretch(ByVal dsSketchMgr As SketchManager, ByRef dsEntities As DispatchWrapper(), ByRef crossingBoxStartCorner As Double(), ByRef crossingBoxEndCorner As Double())
        
'Initialize output entities array
        Dim entitiesIndex As Integer = 0
        
Dim entitiesCount As Integer = 3
        dsEntities =
New DispatchWrapper(entitiesCount) {}

        
'Draw polyline
        Dim closed As Boolean = True
        Dim coordinates As Double() = {1, 1, 3, 1, 3, 3, _
         1, 3}
        
Dim dsPolyline As PolyLine = dsSketchMgr.InsertPolyline2D(coordinates, closed)

        
'Add polyline to output array of entities
        dsEntities(System.Math.Max(System.Threading.Interlocked.Increment(entitiesIndex), entitiesIndex - 1)) = New DispatchWrapper(dsPolyline)

        
'Draw line
        Dim startPoint As Double() = {4, 1, 0}
        
Dim endPoint As Double() = {4, 5, 0}
        
Dim dsLine As Line = dsSketchMgr.InsertLine(startPoint(0), startPoint(1), startPoint(2), endPoint(0), endPoint(1), endPoint(2))

        
'Add line to output array of entities
        dsEntities(System.Math.Max(System.Threading.Interlocked.Increment(entitiesIndex), entitiesIndex - 1)) = New DispatchWrapper(dsLine)

        
'Draw circle
        Dim radius As Double = 1
        
Dim centerPoint As Double() = {6, 2, 0}
        
Dim dsCircle As Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1), centerPoint(2), radius)

        
'Add circle to output array of entities
        dsEntities(System.Math.Max(System.Threading.Interlocked.Increment(entitiesIndex), entitiesIndex - 1)) = New DispatchWrapper(dsCircle)

        
'Specify crossing coordinates
        crossingBoxStartCorner = New Double() {0.6, 2, 0}
        crossingBoxEndCorner =
New Double() {8, 6, 0}
    
End Sub

    Sub FilletEntities(ByVal dsSketchMgr As SketchManager)
        
Dim firstPointOnEntityDblArray As Double() = Nothing
        Dim firstEntityArray As DispatchWrapper() = Nothing
        Dim secondPointOnEntityDblArray As Double() = Nothing
        Dim secondEntityArray As DispatchWrapper() = Nothing

        'Prepare entities for fillet
        DrawEntitiesForFillet(dsSketchMgr, firstPointOnEntityDblArray, firstEntityArray, secondPointOnEntityDblArray, secondEntityArray)

        
'Zoom extents
        dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing)

        MessageBox.Show(
"Entities before FILLET.")

        
'Set fillet radius
        Dim filletRadius As Double = 1.5
        SetFilletRadius(dsDoc, filletRadius)

        
'Do fillet entities
        dsSketchMgr.FilletEntities(firstPointOnEntityDblArray, firstEntityArray, secondPointOnEntityDblArray, secondEntityArray)

        
'Zoom extents
        dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing)

        MessageBox.Show(
"Entities after FILLET.")
    
End Sub

    Sub DrawEntitiesForFillet(ByVal dsSketchMgr As SketchManager, ByRef firstPointOnEntityDblArray As Double(), ByRef firstEntityArray As DispatchWrapper(), ByRef secondPointOnEntityDblArray As Double(), ByRef secondEntityArray As DispatchWrapper())
        
'Count of entity pairs to fillet
        Dim count As Integer = 3

        
'Initialize output arrays
        firstPointOnEntityDblArray = New Double(count * 3 - 1) {}
        firstEntityArray =
New DispatchWrapper(count - 1) {}
        secondPointOnEntityDblArray =
New Double(count * 3 - 1) {}
        secondEntityArray =
New DispatchWrapper(count - 1) {}
        
Dim entityIndex As Integer = 0
        
Dim coordinateIndex As Integer = 0

        
'--------Draw the first pair of entities to fillet-----------------------

        'Draw a line
        Dim startPoint As Double() = {0, 0, 0}
        
Dim endPoint As Double() = {5, 0, 0}
        
Dim dsLine As Line = dsSketchMgr.InsertLine(startPoint(0), startPoint(1), startPoint(2), endPoint(0), endPoint(1), endPoint(2))

        
'Add line entity to output arrays
        firstEntityArray(entityIndex) = New DispatchWrapper(dsLine)
        firstPointOnEntityDblArray(coordinateIndex) = endPoint(0)
        firstPointOnEntityDblArray(coordinateIndex + 1) = endPoint(1)
        firstPointOnEntityDblArray(coordinateIndex + 2) = endPoint(2)

        
'Draw an arc
        Dim radius As Double = 1
        
Dim centerPoint As Double() = {2, -1, 0}
        
Dim startAngle As Double = Math.PI
        
Dim endAngle As Double = 1.5 * Math.PI
        
Dim dsArc As CircleArc = dsSketchMgr.InsertArc(centerPoint(0), centerPoint(1), centerPoint(2), radius, startAngle, endAngle)

        
'Add arc entity to output arrays
        secondEntityArray(entityIndex) = New DispatchWrapper(dsArc)
        secondPointOnEntityDblArray(coordinateIndex) = centerPoint(0) - radius
        secondPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1)
        secondPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)

        
'Increase entity index
        entityIndex += 1
        
'Increase coordinate index
        coordinateIndex += 3

        
'--------Draw the second pair of entities to fillet----------------------

        'Draw a line
        startPoint = New Double() {11, 0, 0}
        endPoint =
New Double() {16, 0, 0}
        dsLine = dsSketchMgr.InsertLine(startPoint(0), startPoint(1), startPoint(2), endPoint(0), endPoint(1), endPoint(2))

        
'Add line entity to output arrays
        firstEntityArray(entityIndex) = New DispatchWrapper(dsLine)
        firstPointOnEntityDblArray(coordinateIndex) = endPoint(0)
        firstPointOnEntityDblArray(coordinateIndex + 1) = endPoint(1)
        firstPointOnEntityDblArray(coordinateIndex + 2) = endPoint(2)

        
'Draw a circle
        centerPoint = New Double() {18, -1, 0}
        radius = 1
        
Dim dsCircle As Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1), centerPoint(2), radius)

        
'Add circle entity to output arrays
        secondEntityArray(entityIndex) = New DispatchWrapper(dsCircle)
        secondPointOnEntityDblArray(coordinateIndex) = centerPoint(0) - radius
        secondPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1)
        secondPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)

        
'Increase entity index
        entityIndex += 1
        
'Increase coordinate index
        coordinateIndex += 3

        
'--------Draw the third pair of entities to fillet-----------------------

        'Draw first circle
        centerPoint = New Double() {7, -1, 0}
        radius = 1
        
Dim dsFirstCircle As Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1), centerPoint(2), radius)

        
'Add circle entity to output arrays
        firstEntityArray(entityIndex) = New DispatchWrapper(dsFirstCircle)
        firstPointOnEntityDblArray(coordinateIndex) = centerPoint(0)
        firstPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1) + radius
        firstPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)

        
'Draw second circle
        centerPoint(0) = 9
        
Dim dsSecondCircle As Circle = dsSketchMgr.InsertCircle(centerPoint(0), centerPoint(1), centerPoint(2), radius)

        
'Add circle entity to output arrays
        secondEntityArray(entityIndex) = New DispatchWrapper(dsSecondCircle)
        secondPointOnEntityDblArray(coordinateIndex) = centerPoint(0)
        secondPointOnEntityDblArray(coordinateIndex + 1) = centerPoint(1) + radius
        secondPointOnEntityDblArray(coordinateIndex + 2) = centerPoint(2)
    
End Sub

    Sub SetFilletRadius(ByVal dsDoc As Document, ByVal filletRadius As Double)
        
Dim setResult As dsSetCommandOptionResult_e
        
Dim filletRadCommandOption As dsCommandOptionDouble_e = dsCommandOptionDouble_e.dsCommandOptionDouble_SetFltRad

        dsDoc.SetCommandOptionDouble(filletRadCommandOption, filletRadius, setResult)
        
If dsSetCommandOptionResult_e.dsSetCommandOptionResult_Success <> setResult Then
            MessageBox.Show("Document.SetCommandOptionDouble() returns " & setResult.ToString() & " after setting of " & filletRadCommandOption & " command option.")
        
End If
    End Sub

    Function ConnectToDraftSight() As DraftSight.Interop.dsAutomation.Application
        
Dim dsApp As DraftSight.Interop.dsAutomation.Application = Nothing

        Try
            'Connect to DraftSight
            dsApp = DirectCast(Marshal.GetActiveObject("DraftSight.Application"), DraftSight.Interop.dsAutomation.Application)
        
Catch ex As Exception
            MessageBox.Show(
"Failed to connect to DraftSight. Cause: " & ex.Message)
            dsApp =
Nothing
        End Try

        Return dsApp
    
End Function
End
Module



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Fillet and Stretch Sketch Entities Example (VB.NET)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2019 SP04

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.