UCS Rotation + Blocks

Anonymous · ‎07-09-2007

I know this has been answered all of this forum but I can't seem to adapt it no matter how hard I try...

My Code is below and it is driving me nuts!!!

Private Sub cmdCancel_Click()
End
End Sub

Private Sub cmdNoPlants_Click()
Select Case Abs(Int(Val(cmbSpacing.Value) * -1))
Case Is = 0
txtNoPlants = (txtPolyline.Value * 0)
Case Is = 6
txtNoPlants = (txtPolyline.Value * 4.608)
Case Is = 9
txtNoPlants = (txtPolyline.Value * 2.053)
Case Is = 12
txtNoPlants = (txtPolyline.Value * 1.155)
Case Is = 18
txtNoPlants = (txtPolyline.Value * 0.513)
Case Is = 24
txtNoPlants = (txtPolyline.Value * 0.289)
Case Is = 30
txtNoPlants = (txtPolyline.Value * 0.185)
Case Is = 36
txtNoPlants = (txtPolyline.Value * 0.128)
Case Is = 42
txtNoPlants = (txtPolyline.Value * 0.094)
Case Is = 48
txtNoPlants = (txtPolyline.Value * 0.072)
End Select
End Sub

Private Sub cmdSelectPLine_Click()

Me.Hide

'Declare Variables
Dim returnobj As Object
Dim entbasepnt As Variant
Dim i As Integer

'For Handle Storage
Dim entHandle As String
Dim entry As AcadEntity
'For Handle Storage

On Error Resume Next
ThisDrawing.Utility.GetEntity returnobj, entbasepnt, "Select a Planting Area: "

'For Handle Storage
For Each entry In returnobj
entHandle = returnobj.ObjectID
Next
'For Handle Storage

txtPolyline.Text = (Round(returnobj.Area, 2) * 0.00694) ' & " s.f."

Me.Show

End Sub

Private Sub cmdTagIt_Click()
'Insert the block
Dim blockRefObj As AcadBlockReference
Dim returnPnt As Variant
Dim TagScale As Integer
Dim BlockName As String

' Added for the UCS Rotation Scheme
Dim ucsObj As AcadUCS
Dim origin(0 To 2) As Double
Dim xAxisPoint(0 To 2) As Double
Dim yAxisPoint(0 To 2) As Double
' End the UCS Rotation Scheme

Me.Hide
returnPnt = ThisDrawing.Utility.GetPoint(, "Select Insertion Point: ")

If optScale192.Value = True Then
TagScale = 192
End If
If optScale96.Value = True Then
TagScale = 96
End If
If optScale48.Value = True Then
TagScale = 48
End If
If optScale10.Value = True Then
TagScale = (10 * 12)
End If
If optScale20.Value = True Then
TagScale = (20 * 12)
End If
If optScale30.Value = True Then
TagScale = (30 * 12)
End If
If optScale40.Value = True Then
TagScale = (40 * 12)
End If
If optScale50.Value = True Then
TagScale = (50 * 12)
End If
If optScale100.Value = True Then
TagScale = (100 * 12)
End If

If optJustLeft = True Then
BlockName = "BedLabel_L"
End If
If optJustRight = True Then
BlockName = "BedLabel_R"
End If

'MsgBox (BlockName)

' Added for the UCS Rotation Scheme
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt, BlockName, TagScale, TagScale, 1#, 0)

'Get the UCS transformation matrix
Dim TransMatrix As Variant
MsgBox (TransMatrix)
'TransMatrix = ucsObj.GetUCSMatrix()

'Transform the block to the UCS coordinates
blockRefObj.TransformBy (TransMatrix)
blockRefObj.Update
'End the UCS Rotation Scheme

'Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(returnPnt, BlockName, TagScale, TagScale, 1, 0)

'Get the attributes for the block reference
Dim varAttributes As Variant
Dim PlantName As String
varAttributes = blockRefObj.GetAttributes

PlantName = txtPlantName.Value

If PlantName = "" Then
PlantName = " "
End If

'Inserting Attributes
varAttributes(0).TextString = Round(txtNoPlants.Value, 0)
varAttributes(1).TextString = PlantName
varAttributes(2).TextString = cmbSpacing.Value & " Inch Spacing"
varAttributes(3).TextString = Round(txtPolyline.Value, 2) & " s.f."
On Error Resume Next

'Get the attributes again
Dim newvarAttributes As Variant
newvarAttributes = blockRefObj.GetAttributes

'Clear the form
txtNoPlants.Value = ""
txtPlantName.Value = ""
txtPolyline.Value = ""

Me.Show
End Sub

Private Sub UserForm_Initialize()
cmbSpacing.AddItem "0" 'ListIndex = 0
cmbSpacing.AddItem "6" 'ListIndex = 1
cmbSpacing.AddItem "9" 'ListIndex = 2
cmbSpacing.AddItem "12" 'ListIndex = 3
cmbSpacing.AddItem "18" 'ListIndex = 4
cmbSpacing.AddItem "24" 'ListIndex = 5
cmbSpacing.AddItem "30" 'ListIndex = 6
cmbSpacing.AddItem "36" 'ListIndex = 7
cmbSpacing.AddItem "42" 'ListIndex = 8
cmbSpacing.AddItem "48" 'ListIndex = 9
End Sub

Please, if anyone can find my problem, just let me know. Thanks a ton!

Anonymous · ‎07-09-2007

This [TransMatrix] is empty. You need to look at the help file example of
how to construct a matrix.

joe ...

wrote in message news:5650968@discussion.autodesk.com...
I know this has been answered all of this forum but I can't seem to adapt it
no matter how hard I try...

My Code is below and it is driving me nuts!!!

Private Sub cmdCancel_Click()
End
End Sub

Private Sub cmdNoPlants_Click()
Select Case Abs(Int(Val(cmbSpacing.Value) * -1))
Case Is = 0
txtNoPlants = (txtPolyline.Value * 0)
Case Is = 6
txtNoPlants = (txtPolyline.Value * 4.608)
Case Is = 9
txtNoPlants = (txtPolyline.Value * 2.053)
Case Is = 12
txtNoPlants = (txtPolyline.Value * 1.155)
Case Is = 18
txtNoPlants = (txtPolyline.Value * 0.513)
Case Is = 24
txtNoPlants = (txtPolyline.Value * 0.289)
Case Is = 30
txtNoPlants = (txtPolyline.Value * 0.185)
Case Is = 36
txtNoPlants = (txtPolyline.Value * 0.128)
Case Is = 42
txtNoPlants = (txtPolyline.Value * 0.094)
Case Is = 48
txtNoPlants = (txtPolyline.Value * 0.072)
End Select
End Sub

Private Sub cmdSelectPLine_Click()

Me.Hide

'Declare Variables
Dim returnobj As Object
Dim entbasepnt As Variant
Dim i As Integer

'For Handle Storage
Dim entHandle As String
Dim entry As AcadEntity
'For Handle Storage

On Error Resume Next
ThisDrawing.Utility.GetEntity returnobj, entbasepnt, "Select a Planting
Area: "

'For Handle Storage
For Each entry In returnobj
entHandle = returnobj.ObjectID
Next
'For Handle Storage

txtPolyline.Text = (Round(returnobj.Area, 2) * 0.00694) ' & " s.f."

Me.Show

End Sub

Private Sub cmdTagIt_Click()
'Insert the block
Dim blockRefObj As AcadBlockReference
Dim returnPnt As Variant
Dim TagScale As Integer
Dim BlockName As String

' Added for the UCS Rotation Scheme
Dim ucsObj As AcadUCS
Dim origin(0 To 2) As Double
Dim xAxisPoint(0 To 2) As Double
Dim yAxisPoint(0 To 2) As Double
' End the UCS Rotation Scheme

Me.Hide
returnPnt = ThisDrawing.Utility.GetPoint(, "Select Insertion Point: ")

If optScale192.Value = True Then
TagScale = 192
End If
If optScale96.Value = True Then
TagScale = 96
End If
If optScale48.Value = True Then
TagScale = 48
End If
If optScale10.Value = True Then
TagScale = (10 * 12)
End If
If optScale20.Value = True Then
TagScale = (20 * 12)
End If
If optScale30.Value = True Then
TagScale = (30 * 12)
End If
If optScale40.Value = True Then
TagScale = (40 * 12)
End If
If optScale50.Value = True Then
TagScale = (50 * 12)
End If
If optScale100.Value = True Then
TagScale = (100 * 12)
End If

If optJustLeft = True Then
BlockName = "BedLabel_L"
End If
If optJustRight = True Then
BlockName = "BedLabel_R"
End If

'MsgBox (BlockName)

' Added for the UCS Rotation Scheme
Dim insertionPnt(0 To 2) As Double
insertionPnt(0) = 2#: insertionPnt(1) = 2#: insertionPnt(2) = 0
Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(insertionPnt,
BlockName, TagScale, TagScale, 1#, 0)

'Get the UCS transformation matrix
Dim TransMatrix As Variant
MsgBox (TransMatrix)
'TransMatrix = ucsObj.GetUCSMatrix()

'Transform the block to the UCS coordinates
blockRefObj.TransformBy (TransMatrix)
blockRefObj.Update
'End the UCS Rotation Scheme

'Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock(returnPnt,
BlockName, TagScale, TagScale, 1, 0)

'Get the attributes for the block reference
Dim varAttributes As Variant
Dim PlantName As String
varAttributes = blockRefObj.GetAttributes

PlantName = txtPlantName.Value

If PlantName = "" Then
PlantName = " "
End If

'Inserting Attributes
varAttributes(0).TextString = Round(txtNoPlants.Value, 0)
varAttributes(1).TextString = PlantName
varAttributes(2).TextString = cmbSpacing.Value & " Inch Spacing"
varAttributes(3).TextString = Round(txtPolyline.Value, 2) & " s.f."
On Error Resume Next

'Get the attributes again
Dim newvarAttributes As Variant
newvarAttributes = blockRefObj.GetAttributes

'Clear the form
txtNoPlants.Value = ""
txtPlantName.Value = ""
txtPolyline.Value = ""

Me.Show
End Sub

Private Sub UserForm_Initialize()
cmbSpacing.AddItem "0" 'ListIndex = 0
cmbSpacing.AddItem "6" 'ListIndex = 1
cmbSpacing.AddItem "9" 'ListIndex = 2
cmbSpacing.AddItem "12" 'ListIndex = 3
cmbSpacing.AddItem "18" 'ListIndex = 4
cmbSpacing.AddItem "24" 'ListIndex = 5
cmbSpacing.AddItem "30" 'ListIndex = 6
cmbSpacing.AddItem "36" 'ListIndex = 7
cmbSpacing.AddItem "42" 'ListIndex = 8
cmbSpacing.AddItem "48" 'ListIndex = 9
End Sub

Please, if anyone can find my problem, just let me know. Thanks a ton!

Anonymous · ‎07-09-2007

Is it the part that I have commented out...with the matrix.

BTW, I am reading your book as we speak! Message was edited by: stck2mlon

Anonymous · ‎07-09-2007

i don't see where you are doing anything like that. take a look at the help
file example, it's a bit complex.

just out of curiousity, which one?

joe ...

wrote in message news:5651046@discussion.autodesk.com...
Is it the part that I have commented out...with the matrix.

BTW, I am reading your book as we speak!

Message was edited by: stck2mlon

Anonymous · ‎07-09-2007

AutoCAD 2004 VBA. Great book.

I am really struggling with this part. I will work through the night and post any discovveries in the morning.

Community

UCS Rotation + Blocks

UCS Rotation + Blocks

UCS Rotation + Blocks