Rotation of dimension

Discussion in 'AutoCAD' started by Frank Jan Koole, Apr 8, 2004.

  1. 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
     
    Frank Jan Koole, Apr 8, 2004
    #1
  2. Frank Jan Koole

    Mark Propst Guest

    If Not dimX.Rotation = 1.57 Then

    consider the lisp expression
    (RTOS(* PI 0.5)2 16)
    evaluates to:
    "1.570796326794896"
     
    Mark Propst, Apr 8, 2004
    #2
  3. 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
     
    Frank Jan Koole, Apr 9, 2004
    #3
  4. Frank Jan Koole

    Mark Propst Guest

    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
     
    Mark Propst, Apr 10, 2004
    #4
  5. Frank Jan Koole

    thenrich Guest

    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
     
    thenrich, Apr 13, 2004
    #5
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.