Message 1 of 2
block insert
Not applicable
06-16-2005
07:57 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
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