Here it is.
Code:
Sub BasicVlv()
Dim i As Integer
Dim Pnts() As Double
Dim CtrPnt(0 To 2) As Double
Dim Pnt1(0 To 2) As Double
Dim Pnt2(0 To 2) As Double
Dim insPnt(0 To 2) As Double
Dim ent As AcadEntity
Dim blockRefObj As AcadBlockReference
Dim blockObj As AcadBlock
Dim plineObj As AcadLWPolyline
Dim WipeOutobj As AcadWipeout
Dim StartPnt(0 To 2) As Double
Dim EndPnt(0 To 2) As Double
Dim blkName As String
Dim SelSet As AcadSelectionSet
Dim SelArray() As Object
Dim clr As AcadAcCmColor
Dim ip As Variant
Set clr = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor." & Left(AcadApplication.Version, 2))
clr.ColorIndex = acByLayer
blkName = "BasicVlv"
' Define the block Insertion Point
CtrPnt(0) = 0: CtrPnt(1) = 0: CtrPnt(2) = 0
'create block definition
Set blockObj = ThisDrawing.Blocks.Add(CtrPnt, blkName)
'construct basic valve shape around 0,0
ReDim Pnts(0 To 9)
Pnts(0) = -4: Pnts(1) = 2
Pnts(2) = -4: Pnts(3) = -2
Pnts(4) = 4: Pnts(5) = 2
Pnts(6) = 4: Pnts(7) = -2
Pnts(8) = -4: Pnts(9) = 2
'since the WIPEOUT command adds it to the active space, make sure ms is active
ThisDrawing.ActiveSpace = acModelSpace
ThisDrawing.SendCommand "wipeout" & vbCr & Pnts(0) & "," & Pnts(1) & vbCr & Pnts(2) & "," & Pnts(3) & vbCr & Pnts(4) & _
"," & Pnts(5) & vbCr & Pnts(6) & "," & Pnts(7) & vbCr & vbCr
Set SelSet = AddSelectionSet("VlvBlock")
SelSet.Select acSelectionSetLast
Set WipeOutobj = SelSet.Item(0)
With WipeOutobj
.Layer = "0"
.TrueColor = clr
.Update
End With
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(Pnts)
With plineObj
.TrueColor = clr
.Linetype = "Continuous"
.Lineweight = acLnWt030
.Layer = "0"
'.Closed = True
.Update
End With
'points for selectionset window
Pnt1(0) = -5: Pnt1(1) = -3: Pnt1(2) = 0
Pnt2(0) = 5: Pnt2(1) = 3: Pnt2(2) = 0
SelSet.Clear
SelSet.Select acSelectionSetWindow, Pnt1, Pnt2
ReDim SelArray(0 To SelSet.Count - 1)
For Each ent In SelSet
Set SelArray(i) = SelSet.Item(i)
i = i + 1
Next ent
ThisDrawing.CopyObjects SelArray, blockObj
SelSet.Erase
SelSet.Delete
'insert method, no input
'ThisDrawing.ModelSpace.InsertBlock insPnt, blkName, 1, 1, 1, 0
'insert method, user input
ip = ThisDrawing.Utility.GetPoint(, "Select an insertion point for the valve:")
ThisDrawing.ModelSpace.InsertBlock ip, blkName, 1, 1, 1, 0
End Sub