create block

[pipu123]

'question !!!!!!!!
' to create selection set there is SelectOnScreen Line 50
'I want to write down in program select linia linia1 linia2
' without clicking mouse on screen
' How to add linia linia1 linia2 to my block without using my muouse
' i want to write program that will add these lines

Public Sub TestCopyObjects1()
Dim objSS As AcadSelectionSet
Dim varBase As Variant
Dim objBlock As AcadBlock
Dim strName As String
Dim strErase As String
Dim varEnt As Variant
Dim objSourceEnts() As Object
Dim varDestEnts As Variant
Dim dblOrigin(2) As Double
Dim intI As Integer

With ThisDrawing.Utility

Dim k0Deg, k60Deg, k120Deg As Double

k0Deg = .AngleToReal("0d", acDegrees)
k60Deg = .AngleToReal("60d", acDegrees)
k120Deg = .AngleToReal("120d", acDegrees)

Const od100p As Integer = 100

Dim pktP0, pktP1, pktP2, pktP3 As Variant

pktP0 = .GetPoint(, vbCr & "Pick the start point: ")
pktP1 = .PolarPoint(pktP0, k0Deg, od100p)
pktP2 = .PolarPoint(pktP0, k60Deg, od100p)
pktP3 = .PolarPoint(pktP0, k120Deg, od100p)


Dim linia, linia1, linia2 As AcadLine
Set linia = ThisDrawing.ModelSpace.AddLine(pktP0, pktP1)
Set lini1 = ThisDrawing.ModelSpace.AddLine(pktP0, pktP2)
Set linia2 = ThisDrawing.ModelSpace.AddLine(pktP0, pktP3)


End With
'choose a selection set name that you only use as temporary storage and
'ensure that it does not currently exist
On Error Resume Next
ThisDrawing.SelectionSets.Item("TempSSet").Delete
Set objSS = ThisDrawing.SelectionSets.Add("TempSSet")
objSS.SelectOnScreen '!!!!!!!!!!!!!!!!!!!!!!!

'' get the other user input
With ThisDrawing.Utility
.InitializeUserInput 1
strName = .GetString(True, vbCr & "Enter a block name: ")
.InitializeUserInput 1
varBase = .GetPoint(, vbCr & "Pick a base point: ")

End With

'' set WCS origin
dblOrigin(0) = 0: dblOrigin(1) = 0: dblOrigin(2) = 0

'' create the block
Set objBlock = ThisDrawing.Blocks.Add(dblOrigin, strName)

'' put selected entities into an array for CopyObjects
ReDim objSourceEnts(objSS.Count - 1)
For intI = 0 To objSS.Count - 1
Set objSourceEnts(intI) = objSS(intI)
Next

'' copy the entities into block
varDestEnts = ThisDrawing.CopyObjects(objSourceEnts, objBlock)

'' move copied entities so that base point becomes origin
For Each varEnt In varDestEnts
varEnt.Move varBase, dblOrigin
Next

'' clean up selection set
objSS.Delete
End Sub