Rotation of dimension

Hi,

Still trying to get where I wanna be. I tried a new way and I thought I was
close, but one way or another this fails:

Sub SelectVerDim()

Dim ssType(0) As Integer
Dim ssData(0) As Variant
Dim ssVerDim As AcadSelectionSet
Dim mode As Integer
Dim BeginX As Variant
Dim EndX As Variant
Dim dimX As AcadDimension
Dim removeObjects() As AcadEntity
Dim I As Integer

I = 0

Do
For Each dimX In ThisDrawing.ModelSpace
If Not dimX.Rotation = 1.57 Then
Set removeObjects(I) = dimX
End If
I = I + 1
Next dimX
Loop Until I = dimX.Count - 1

ssType(0) = 0: ssData(0) = "DIMENSION"

Set ssVerDim = ThisDrawing.PickfirstSelectionSet

mode = acSelectionSetAll

With ssVerDim
.Clear
.Select mode, , , ssType, ssData
.RemoveItems removeObjects
SendCommand "(sssetfirst nil (ssget " & Chr(34) & "_P" & Chr(34) &
")) "
.Delete
End With

Set ssVerDim = Nothing
Erase ssData
Erase ssType
mode = Empty
Erase BeginX
Erase EndX
Set dimX = Nothing

End Sub

Can anybody tell me why? I can't figure it out, also because of a lack of
knowledge.

Frank

 

If Not dimX.Rotation = 1.57 Then

consider the lisp expression
(RTOS(* PI 0.5)2 16)
evaluates to:
"1.570796326794896"

 

Mark,

Thank you for your reaction and it might help if I knew how to declare the
lisp expression to a variable.
I tried this:
Dim Radians as Variant
....
Radians = sendcommand (RTOS(* PI 0.5)2 16)
....
If Not dimX.Rotation = Radians Then
.....
This doesn't work.

Second of all I don't think that's the problem, because in the developer
guide it has the following example for rotation:
Sub Example_Rotation()

' This example creates a text object in model space.
' It then changes the Rotation of the text object.
Dim textObj As AcadText
Dim textString As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double

' Define the text object
textString = "Hello, World."
insertionPoint(0) = 3: insertionPoint(1) = 3: insertionPoint(2) = 0:
height = 0.5

' Create the text object in model space
Set textObj = ThisDrawing.ModelSpace.AddText(textString,
insertionPoint, height)
ZoomAll
MsgBox "The Rotation is " & textObj.rotation, vbInformation, "Rotation
Example"

' Change the value of the Rotation to 45 degrees (.785 radians)
textObj.rotation = 0.785 '<=
ZoomAll
MsgBox "The Rotation is set to " & textObj.rotation, vbInformation,
"Rotation Example"

End Sub

So could anybody help me with the problem in my first post?
Thank you in advance,
Frank

 

Sorry Frank,
I just meant to point out to you that the actual value of verticalness in
terms of radians is not exactly 1.57
Since Pi is an infinitely unresolvable decimal fraction, all angle
calcuations can become involved with rounding errors so you need a way to
find a value that is close enough to what you're looking for such that it is
accurate enough for whatever your purposes are.

the lisp rtos line was just a way to see that at the command line,
the fact that one half pi (which is vertical) rounds off to
"1.570796326794896" at 15 decimal places.
If you could go more than 15 decimals the numbers would just keep going and
never get to an even 0.

the only point I was trying to make was that your code said

If Not dimX.Rotation = 1.57 Then
so it's not going to correctly find the vertical dimensions.
The only dimensions that would find is ones that were just slightly off
vertical such that their rotation was =
1.5700000000000000000000000000000000000000000000000
etc.

but if you have something like:
Dim Fuzz as Double
Fuzz = 0.0000001
or
Fuzz = 0.00001
or
Fuzz = 0.001
' (or whatever number of decimal places you need for accuracy)

If ABS(dimX.Rotation - 1.570796326794896) < Fuzz Then
Msgbox "This is close enough for who it's for!"
end if

or something to that effect

sorry for confusing you with the lisp stuff,

Hope that helps.
If that's not what you need, keep coming back with the question till we get
it right.
Mark

 

Don't know what your problem is with your code but I do something similiar using objectDBX. You'll need to register the axdb15.dll in the AutoCAD 2002 folder if that's what your using.

I've coded this function in .NET but I assume it would work the same in VB or VBA. I'm getting some points from the block but you could also get the rotation of the text also which I think would give you the dimension rotaion.

Public Function GetDimBlock(ByVal Location As Object) As Object
'dimStartPoint = 0
'dimEndPoint = 1
'dimLocation = 2
Location = Location(0)
Try
Dim dbxDoc As AxDbDocument = l_AcadApp.GetInterfaceObject("objectdbx.axdbdocument")
Dim i As Integer
Dim IdPairs As Object
Dim IdPair As AXDB15Lib.AcadIdPair
Dim ObjArray(0) As AXDB15Lib.AcadObject
Dim Ent As Object
Dim Obj As AXDB15Lib.AcadObject
Dim Doc As AcadDocument
Dim cntr As Integer
Doc = currentEnt.Document

ObjArray(0) = currentEnt
Doc.CopyObjects(ObjArray, dbxDoc.ModelSpace, IdPairs)
For i = LBound(IdPairs) To UBound(IdPairs)
IdPair = IdPairs(i)
Ent = Doc.ObjectIdToObject(IdPair.Key)
If TypeOf Ent Is AXDB15Lib.AcadBlock Then
If Not Ent.IsLayout Then
For Each Obj In Ent
If TypeOf Obj Is AXDB15Lib.AcadPoint Then
If cntr = Location Then
Return Obj.coordinates
End If
cntr = cntr + 1
End If
Next
End If
End If
Next i

Catch ex As Exception
MsgBox(ex.Message & Chr(13) & ex.StackTrace)
Return Nothing
End Try

Works great - no problems to date