Create Block Definition and Insert Block Instance Example (VBA)
This example shows how to create a block definition and insert a block
instance in a drawing. This example also shows how to migrate the now
obsolete and not-supported block definition and block instance APIs (IBlockDefinition
and IBlockInstance) to the new block definition and sketch block instance
APIs (ISketchBlockDefinition and ISketchBlockInstance).
'-----------------------------------------------
'
' Preconditions: Drawing is open.
'
' Postconditions:
' (1)
Block definition is created.
' (2)
First instance of the block is inserted in the upper-left
' corner
of the drawing sheet.
' (3)
Second instance of the block is inserted into the
' drawing
sheet.
'
' NOTE: Customize the creation of the entities to suit
your situation.
'
'-----------------------------------------------
Option Explicit
Public Enum swBalloonStyle_e
swBS_None
= 0
swBS_Circular
= 1
swBS_Triangle
= 2
swBS_Hexagon
= 3
swBS_Box
= 4
swBS_Diamond
= 5
swBS_SplitCirc
= 6
swBS_Pentagon
= 7
swBS_FlagPentagon
= 8
swBS_FlagTriangle
= 9
swBS_Underline
= 10
End Enum
Public Enum swBalloonFit_e
swBF_Tightest
= 0
swBF_1Char
= 1
swBF_2Chars
= 2
swBF_3Chars
= 3
swBF_4Chars
= 4
swBF_5Chars
= 5
End Enum
Public Enum swLeaderSide_e
swLS_SMART
= 0
swLS_LEFT
= 1
swLS_RIGHT
= 2
End Enum
Sub PositionNote _
(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2,
swSkNote As SldWorks.Note, X_pos As Double, Y_pos As Double, Z_pos As
Double)
Dim
swAnn As
SldWorks.Annotation
Dim
nRetVal As
Long
Dim
bRet As
Boolean
Set
swAnn = swSkNote.GetAnnotation
Debug.Assert
Not swAnn Is Nothing
swSkNote.Angle
= 0#
bRet
= swSkNote.SetBalloon(swBS_None,
swBF_Tightest): Debug.Assert bRet
nRetVal
= swAnn.SetLeader2(False, swLS_SMART,
True, False, False, False): Debug.Assert 0 = nRetVal
bRet
= swAnn.SetPosition(X_pos, Y_pos,
Z_pos): Debug.Assert bRet
'
Redraw to see changes; however, this is expensive
swModel.GraphicsRedraw2
End Sub
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swDraw As
SldWorks.DrawingDoc
Dim
swSkSeg(13) As
SldWorks.SketchSegment
Dim
swSkPt(3) As
SldWorks.SketchPoint
Dim
swSkNote(2) As
SldWorks.Note
Dim
vSkSeg As
Variant
Dim
vSkPt As
Variant
Dim
vSkNote As
Variant
Dim
bRet As
Boolean
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
OBSOLETE BLOCKS: These APIs are obsolete and are not
'
supported as of SolidWorks 2007
'
Dim swBlockDef As
SldWorks.BlockDefinition
'
Dim swBlockInst As
SldWorks.BlockInstance
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
NEW BLOCKS: These APIs supersede and replace the obsolete
'
block-related APIs as of SolidWorks 2007
Dim
swSketchBlockDef As
SldWorks.SketchBlockDefinition
Dim
swBlockInst As
SldWorks.SketchBlockInstance
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
NEW BLOCKS: Additional declarations for new blocks in this example
Dim
swSketchMgr As
SldWorks.SketchManager
Dim
swModelDocExt As
SldWorks.ModelDocExtension
Dim
swMathUtil As
SldWorks.MathUtility
Dim
swMathPoint As
SldWorks.MathPoint
Dim
nPt(2) As
Double
Dim
vPt As
Variant
Dim
nbrSelObjects As
Long
Dim
vInstPt As
Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swDraw = swModel
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
NEW BLOCKS: Interfaces needed for new block APIs in this example
Set
swSketchMgr = swModel.SketchManager
Set
swModelDocExt = swModel.Extension
Set
swMathUtil = swApp.GetMathUtility
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Turn off grid and entity snapping
swModel.SetAddToDB True
'
Revision box
Set
swSkSeg(0) = swModel.CreateLine2(0.008372353756316,
0.207929860362, 0#, 0.05495488122133, 0.207929860362, 0#)
Set
swSkSeg(1) = swModel.CreateLine2(0.05495488122133,
0.207929860362, 0#, 0.05495488122133, 0.1992788195471, 0#)
Set
swSkSeg(2) = swModel.CreateLine2(0.05495488122133,
0.1992788195471, 0#, 0.008372353756316, 0.1992788195471, 0#)
Set
swSkSeg(3) = swModel.CreateLine2(0.008372353756316,
0.1992788195471, 0#, 0.008372353756316, 0.207929860362, 0#)
Set
swSkSeg(4) = swModel.CreateLine2(0.023613610833382,
0.207929860362, 0#, 0.023613610833382, 0.1992788195471, 0#)
Set
swSkSeg(5) = swModel.CreateLine2(0.03964919362569,
0.207929860362, 0#, 0.03964919362569, 0.1992788195471, 0#)
'
Clear selections; otherwise, notes are attached to line
swModel.ClearSelection2 True
'
Revision notes
Set
swSkNote(0) = swModel.InsertNote("Cell
1")
Set
swSkNote(1) = swModel.InsertNote("Cell
2")
Set
swSkNote(2) = swModel.InsertNote("Cell
3")
PositionNote
swApp, swModel, swSkNote(0), 0.009481461553102, 0.2052680016497, 0#
PositionNote
swApp, swModel, swSkNote(1), 0.025613610833382, 0.2052680016497, 0#
PositionNote
swApp, swModel, swSkNote(2), 0.04275469545669, 0.2052680016497, 0#
'
Points for circles
Set
swSkPt(0) = swModel.CreatePoint2(0.02700536474232,
0.1708856599494, 0#)
Set
swSkPt(1) = swModel.CreatePoint2(0.02700536474232,
0.1815330947985, 0#)
Set
swSkPt(2) = swModel.CreatePoint2(0.03964919362569,
0.1815330947985, 0#)
Set
swSkPt(3) = swModel.CreatePoint2(0.05029662847483,
0.1708856599494, 0#)
'
Circles
Set
swSkSeg(6) = swModel.CreateCircle2(swSkPt(0).X,
swSkPt(0).Y, swSkPt(0).Z, 0.03050393605009, 0.169349494074, 0#)
Set
swSkSeg(7) = swModel.CreateCircle2(swSkPt(1).X,
swSkPt(1).Y, swSkPt(1).Z, 0.03305243799009, 0.183621104938, 0#)
Set
swSkSeg(8) = swModel.CreateCircle2(swSkPt(2).X,
swSkPt(2).Y, swSkPt(2).Z, 0.04426584652606, 0.182092003774, 0#)
Set
swSkSeg(9) = swModel.CreateCircle2(swSkPt(3).X,
swSkPt(3).Y, swSkPt(3).Z, 0.05496955467404, 0.164252490194, 0#)
'
Lines between circles
Set
swSkSeg(10) = swModel.CreateLine2(swSkPt(0).X,
swSkPt(0).Y, swSkPt(0).Z, swSkPt(1).X, swSkPt(1).Y, swSkPt(1).Z)
Set
swSkSeg(11) = swModel.CreateLine2(swSkPt(1).X,
swSkPt(1).Y, swSkPt(1).Z, swSkPt(2).X, swSkPt(2).Y, swSkPt(2).Z)
Set
swSkSeg(12) = swModel.CreateLine2(swSkPt(2).X,
swSkPt(2).Y, swSkPt(2).Z, swSkPt(3).X, swSkPt(3).Y, swSkPt(3).Z)
Set
swSkSeg(13) = swModel.CreateLine2(swSkPt(3).X,
swSkPt(3).Y, swSkPt(3).Z, swSkPt(0).X, swSkPt(0).Y, swSkPt(0).Z)
vSkSeg
= swSkSeg
vSkPt
= swSkPt
vSkNote
= swSkNote
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
NEW BLOCKS: Select all sketch segments, sketch points,
'
and notes for the block definition
nbrSelObjects
= swModelDocExt.MultiSelect(vSkSeg,
True, Nothing)
nbrSelObjects
= swModelDocExt.MultiSelect(vSkPt,
True, Nothing)
nbrSelObjects
= swModelDocExt.MultiSelect(vSkNote,
True, Nothing)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'OBSOLETE
BLOCKS
'Set
swBlockDef = swDraw.CreateBlockDefinition("TDE Block", "",
True, vSkSeg, vSkPt, vSkNote, vSkDispDim, Nothing)
'Set
swBlockInst = swBlockDef.InsertInstance(60# / 1000#, -60# / 1000#, 0#,
1#)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'NEW
BLOCKS: Create block definition
Set
swSketchBlockDef = swSketchMgr.MakeSketchBlockFromSelected(Nothing)
'
'
Define an insertion point
nPt(0)
= 60# / 1000#
nPt(1)
= -60# / 1000#
nPt(2)
= 0#
vPt
= nPt
Set
swMathPoint = swMathUtil.CreatePoint(vPt)
'
'
Insert an instance of the block definition
Set
swBlockInst = swSketchMgr.InsertSketchBlockInstance(swSketchBlockDef,
swMathPoint, 1, 0)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Turn on grid and entity snapping
swModel.SetAddToDB False
'
Redraw to see all changes
swModel.GraphicsRedraw2
End Sub