block insert

block insert

Anonymous
Not applicable
351 Views
1 Reply
Message 1 of 2

block insert

Anonymous
Not applicable
The following code creates ablock and inserts it at a user selected location. Can anyone revise the code for me so that the block is inserted at athe selected point but allows for the user to select a rotation angle by picking a second point.
I am new to vba and am struggling to get it to work
regards
John bortoli

Public Sub CreateTendonBlock()
Dim objBlockDefinition As AcadBlock
Dim dblPoint(X To Z) As Double
Dim objCircle As AcadCircle
Dim dblRadius As Double
Dim objLine As AcadLine
Dim dblLineLength As Double
Dim objAttribute As AcadAttribute
Dim dblLength As Double
Dim dblTextHeight As Double
Dim lngMode As Long
Dim strPrompt As String
Dim strTag As String
Dim strDefaultValue As String
'Dim objLine As AcadLine
Dim dblLPoint(X To Z) As Double
Dim dblLPoint_End(X To Z) As Double

Set objBlockDefinition = ThisDrawing.Blocks.Add(dblPoint, TENDON_BLOCK_NAME)

' Add a circle to the block.


dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 1#
dblRadius = 320#
Set objCircle = objBlockDefinition.AddCircle(dblPoint, dblRadius)
objCircle.color = acYellow


'Add a tail to the block.


dblLPoint(X) = 1#
dblLPoint(Y) = 1# - 320
dblLPoint(Z) = 1#

dblLPoint_End(X) = dblLPoint(X)
dblLPoint_End(Y) = dblLPoint(Y) - 1500
dblLPoint_End(Z) = dblLPoint(Z)



Set objLine = objBlockDefinition.AddLine(dblLPoint, dblLPoint_End)
objLine.color = acYellow




' Add attributes to the block.
dblTextHeight = 250#
strDefaultValue = ""

lngMode = acAttributeModeVerify
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "Tendon ID"
strTag = "ID"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)
objAttribute.color = acYellow
objAttribute.Alignment = acAlignmentMiddleCenter
objAttribute.TextAlignmentPoint = dblPoint

lngMode = acAttributeModeInvisible
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "pour number"
strTag = "POUR_NUMBER"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeVerify
dblPoint(X) = -56#
dblPoint(Y) = -750#
dblPoint(Z) = 0#
dblTextHeight = 350#
strPrompt = "Number strands"
strTag = "STRANDS"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

objAttribute.Rotation = 1.571
objAttribute.color = acYellow

dblTextHeight = 250#
lngMode = acAttributeModeInvisible
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "Strand length"
strTag = "LENGTH"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "Casting"
strTag = "CASTING"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 25#
dblPoint(Y) = 25#
dblPoint(Z) = 0#

strPrompt = "Coupler"
strTag = "COUPLER"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 5#
dblPoint(Y) = 5#
dblPoint(Z) = 0#

strPrompt = "Anchor block"
strTag = "ANCHOR"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 5#
dblPoint(Y) = 5#
dblPoint(Z) = 0#

strPrompt = "firstend"
strTag = "1stend"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 5#
dblPoint(Y) = 5#
dblPoint(Z) = 0#

strPrompt = "secondend"
strTag = "2ndend"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight, lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)




End Sub
0 Likes
352 Views
1 Reply
Reply (1)
Message 2 of 2

Anonymous
Not applicable
Hi John,

The general code to select a point is:

Dim Pt(0 to 2) as Double
Dim PtSel(0 to 2) as Double
Dim dAngle as Double
Pt(0) = something created previously
Pt(1) = something created previously

Dim vPt As Variant
vPt = ThisDrawing.Utility.GetPoint(Pt, "Select point to define rotation
angle")

' You will see a rubber band from Pt to the cursor location.

' Set values of a point from the returned variant
PtSel(0) = vPt(0)
PtSel(1) = vPt(1)

' You can then use:
dAngle = ThisDrawing.Utility.AngleFromXAxis(Pt, PtSel)

' and dAngle will be the angle to insert the block. You will need to define
the block with its main axis along the X axis, otherwise you will need to
adjust the dAngle variable to suit.

Laurie Comerford
CADApps

wrote in message news:[email protected]...
The following code creates ablock and inserts it at a user selected
location. Can anyone revise the code for me so that the block is inserted at
athe selected point but allows for the user to select a rotation angle by
picking a second point.
I am new to vba and am struggling to get it to work
regards
John bortoli

Public Sub CreateTendonBlock()
Dim objBlockDefinition As AcadBlock
Dim dblPoint(X To Z) As Double
Dim objCircle As AcadCircle
Dim dblRadius As Double
Dim objLine As AcadLine
Dim dblLineLength As Double
Dim objAttribute As AcadAttribute
Dim dblLength As Double
Dim dblTextHeight As Double
Dim lngMode As Long
Dim strPrompt As String
Dim strTag As String
Dim strDefaultValue As String
'Dim objLine As AcadLine
Dim dblLPoint(X To Z) As Double
Dim dblLPoint_End(X To Z) As Double

Set objBlockDefinition = ThisDrawing.Blocks.Add(dblPoint,
TENDON_BLOCK_NAME)

' Add a circle to the block.


dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 1#
dblRadius = 320#
Set objCircle = objBlockDefinition.AddCircle(dblPoint, dblRadius)
objCircle.color = acYellow


'Add a tail to the block.


dblLPoint(X) = 1#
dblLPoint(Y) = 1# - 320
dblLPoint(Z) = 1#

dblLPoint_End(X) = dblLPoint(X)
dblLPoint_End(Y) = dblLPoint(Y) - 1500
dblLPoint_End(Z) = dblLPoint(Z)



Set objLine = objBlockDefinition.AddLine(dblLPoint, dblLPoint_End)
objLine.color = acYellow




' Add attributes to the block.
dblTextHeight = 250#
strDefaultValue = ""

lngMode = acAttributeModeVerify
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "Tendon ID"
strTag = "ID"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)
objAttribute.color = acYellow
objAttribute.Alignment = acAlignmentMiddleCenter
objAttribute.TextAlignmentPoint = dblPoint

lngMode = acAttributeModeInvisible
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "pour number"
strTag = "POUR_NUMBER"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeVerify
dblPoint(X) = -56#
dblPoint(Y) = -750#
dblPoint(Z) = 0#
dblTextHeight = 350#
strPrompt = "Number strands"
strTag = "STRANDS"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

objAttribute.Rotation = 1.571
objAttribute.color = acYellow

dblTextHeight = 250#
lngMode = acAttributeModeInvisible
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "Strand length"
strTag = "LENGTH"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 1#
dblPoint(Y) = 1#
dblPoint(Z) = 0#

strPrompt = "Casting"
strTag = "CASTING"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 25#
dblPoint(Y) = 25#
dblPoint(Z) = 0#

strPrompt = "Coupler"
strTag = "COUPLER"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 5#
dblPoint(Y) = 5#
dblPoint(Z) = 0#

strPrompt = "Anchor block"
strTag = "ANCHOR"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 5#
dblPoint(Y) = 5#
dblPoint(Z) = 0#

strPrompt = "firstend"
strTag = "1stend"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)

lngMode = acAttributeModeInvisible
dblPoint(X) = 5#
dblPoint(Y) = 5#
dblPoint(Z) = 0#

strPrompt = "secondend"
strTag = "2ndend"
Set objAttribute = objBlockDefinition.AddAttribute(dblTextHeight,
lngMode, _
strPrompt, dblPoint, strTag, strDefaultValue)




End Sub
0 Likes