Author Topic: Is it AutoCAD, or is it me?  (Read 1716 times)

0 Members and 1 Guest are viewing this topic.

BAshworth

  • Guest
Is it AutoCAD, or is it me?
« on: April 14, 2005, 05:59:18 PM »
Hello all you fine swamp people.  Got one to bounce off of you guys.

I am needing to convert two points from WCS values to UCS values.  Not a big problem.  AutoCAD has a function built in for this, so I use it.

Dim Point1 as Variant

Point1=ThisDrawing.Utility.TranslateCoordinates(Point1, acWorld, acUCS, 0)

That works fine.  However, this is when my problem starts.

The next line is

Dim Point3 as Variant

Point3=ThisDrawing.Utility.TranslateCoordinates(Point3, acWorld, acUCS, 0)

Again, it goes off without a hitch, and converts the value in Point3 from WCS coordinates to the current UCS correctly.  Unfortunately, it also changes the value of Point1 to match the value of Point3.

Any ideas of what to look for to figure out what is causing this?

MP

  • Seagull
  • Posts: 17399
Is it AutoCAD, or is it me?
« Reply #1 on: April 14, 2005, 06:03:04 PM »
It sounds like you have multiple variables pointing to the same object. Can you provide the original code?
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

Chuck Gabriel

  • Guest
Is it AutoCAD, or is it me?
« Reply #2 on: April 14, 2005, 08:35:05 PM »
Hey bud.  Long time no argue. :D

I tried the following in AutoCAD 2004, and couldn't reproduce your error:

Code: [Select]

Sub test()
  Dim point1 As Variant
  point1 = ThisDrawing.Utility.GetPoint(, "Pick point1: ")
  point1 = ThisDrawing.Utility.TranslateCoordinates(point1, acWorld, acUCS, 0)
  Dim point3 As Variant
  point3 = ThisDrawing.Utility.GetPoint(, "Pick point3: ")
  point3 = ThisDrawing.Utility.TranslateCoordinates(point3, acWorld, acUCS, 0)
  Debug.Print "point1: " & point1(0) & "," & point1(1) & "," & point1(2)
  Debug.Print "point3: " & point3(0) & "," & point3(1) & "," & point3(2)
End Sub

BAshworth

  • Guest
Is it AutoCAD, or is it me?
« Reply #3 on: April 15, 2005, 12:58:36 AM »
Dang, was hoping it would be an easy "Oh that's a known bug, give up on that pile." answer. :D  Saves me time, saves me work... oh well.

This is a portion of a larger project, but I'll try to extract out the pertinent parts and post them tomorrow.

BTW - This is AutoCAD 2002 VBA.

Chuck - The answer is 42 :twisted:

BAshworth

  • Guest
Is it AutoCAD, or is it me?
« Reply #4 on: April 15, 2005, 10:20:37 AM »
Ok, here is the contents of this module.

Code: [Select]

Option Explicit

Private CoordLength                   As Double
Private PolyVertIndex()               As Double
Private MainCntr                      As Integer

Sub RevBubble()
   
Dim KeyWdList                         As String
Dim Opt                               As String
Dim OptText                           As String
Dim PreOpt                            As String

    SaveSetting "RevisionCloud", "Value", "SystemCoordLenght", ThisDrawing.GetVariable("DIMSCALE") / 3
    CoordLength = ThisDrawing.GetVariable("DIMSCALE") / 3

StartOver:

On Error GoTo EscKeyPressed:

    KeyWdList = "? Options Rectangle Polygon"
    ThisDrawing.Utility.InitializeUserInput 128, KeyWdList
    OptText = "Enter A Selection [?/Options/Rectangle/Polygon <"

    If Opt = "" Then
        OptText = Chr$(10) & Chr$(10) & Chr(10) & OptText & "Rectangle" & ">: "
        Opt = ThisDrawing.Utility.GetKeyword(OptText)

        If Opt = "" Then
            Opt = "Rectangle"
        End If
   
    Else
       
        OptText = Chr$(10) & Chr$(10) & Chr$(10) & OptText & Opt & ">:"
        PreOpt = Opt
        Opt = ThisDrawing.Utility.GetKeyword(OptText)
       
        If Opt = "" Then
            Opt = PreOpt
        End If
   
    End If

    Select Case Opt
       
        Case "Options"
            Call Rev_Options
            DoEvents
            Opt = "Rectangle"
            GoTo StartOver:
           
        Case "Rectangle"
            Call Rev_Rectangle
           
        Case "Polygon"
            Call Rev_Polygon
           
        Case "?"
            ThisDrawing.Utility.Prompt "Stand up, walk yourself back to Ben's desk, ask him your question." & Chr$(10)
   
    End Select
   
EscKeyPressed:

End

End Sub

Private Sub Rev_Rectangle()
   
Dim SecondPoint(0 To 2)               As Double
Dim FourthPoint(0 To 2)               As Double
Dim LaterBeginPoint(0 To 2)           As Double
Dim LaterSecondPoint(0 To 2)    As Double
Dim LaterThirdPoint(0 To 2)           As Double
Dim LaterFourthPoint(0 To 2) As Double
Dim FirstPoint                        As Variant
Dim ThirdPoint                        As Variant

    FirstPoint = ThisDrawing.Utility.GetPoint(, Chr$(10) & "Select first corner point :")
    ThirdPoint = ThisDrawing.Utility.GetCorner(FirstPoint, Chr$(10) & "Select second corner point :")
   
'This part works fine, the points get converted correctly.

    FirstPoint = ThisDrawing.Utility.TranslateCoordinates(FirstPoint, acWorld, acUCS, False)
    ThirdPoint = ThisDrawing.Utility.TranslateCoordinates(ThirdPoint, acWorld, acUCS, False)
   
    SecondPoint(0) = ThirdPoint(0): SecondPoint(1) = FirstPoint(1): SecondPoint(2) = FirstPoint(2)
    FourthPoint(0) = FirstPoint(0): FourthPoint(1) = ThirdPoint(1): FourthPoint(2) = FirstPoint(2)

'These next lines were added because of a similar issue happening to my points.  While it was working through ThirdPoint, it was also changing FirstPoint.
   
    LaterBeginPoint(0) = FirstPoint(0): LaterBeginPoint(1) = FirstPoint(1): LaterBeginPoint(2) = FirstPoint(2)
    LaterSecondPoint(0) = SecondPoint(0): LaterSecondPoint(1) = SecondPoint(1): LaterSecondPoint(2) = SecondPoint(2)
    LaterThirdPoint(0) = ThirdPoint(0): LaterThirdPoint(1) = ThirdPoint(1): LaterThirdPoint(2) = ThirdPoint(2)
    LaterFourthPoint(0) = FourthPoint(0): LaterFourthPoint(1) = FourthPoint(1): LaterFourthPoint(2) = FourthPoint(2):
   
    Call Rev_Draw(FirstPoint, SecondPoint)
    Call Rev_Draw(LaterSecondPoint, ThirdPoint)
    Call Rev_Draw(ThirdPoint, FourthPoint)
    Call Rev_Draw(LaterFourthPoint, LaterBeginPoint)
    Call Rev_Draw_Cloud
   
    ThisDrawing.Utility.Prompt "Rectangle Cloud was Created Successfully :" & Chr(10)
   
    Erase FirstPoint
    Erase ThirdPoint
   
End Sub

Private Sub Rev_Polygon()
   
Dim Cont                              As Boolean
Dim PtStart()                         As Double
Dim StartPoint(0 To 2)                As Double
Dim PtNext()                          As Double
Dim PtLast(0 To 2)                    As Double
Dim Cntr                              As Integer
Dim CurrLin()                         As Object

    Cont = True

    PtStart = ThisDrawing.Utility.GetPoint(, Chr$(10) & "Select point")
        StartPoint(0) = PtStart(0): StartPoint(1) = PtStart(1): StartPoint(2) = PtStart(2)
    PtNext = ThisDrawing.Utility.GetPoint(PtStart, Chr$(10) & "Select next point")
    ReDim CurrLin(0 To Cntr)
    Set CurrLin(Cntr) = ThisDrawing.ModelSpace.AddLine(PtStart, PtNext)
    AutoCAD.Update
    Cntr = 0

    If IsEmpty(PtNext) <> True Then
        Call Rev_Draw(PtStart, PtNext)
    End If
   
    Do While Cont = True
       
        On Error GoTo FinishedPolygon:
       
        If IsEmpty(PtNext) <> True Then
            PtLast(0) = PtNext(0): PtLast(1) = PtNext(1): PtLast(2) = PtNext(2)
            PtNext = ThisDrawing.Utility.GetPoint(PtLast, Chr$(10) & "Select next point")
            Cont = True
            Cntr = Cntr + 1
            ReDim Preserve CurrLin(0 To Cntr)
            Set CurrLin(Cntr) = ThisDrawing.ModelSpace.AddLine(PtLast, PtNext)
            AutoCAD.Update
           
            If IsEmpty(PtNext) <> True Then
           
                Call Rev_Draw(PtLast, PtNext)
               
            End If
           
            If PtNext(0) = PtLast(0) And PtNext(1) = PtStart(1) And PtNext(2) = PtStart(2) Then
                Cont = False
            End If

        Else
       
FinishedPolygon:
           
            Cont = False
       
        End If
   
    Loop

    If StartPoint(0) <> PtLast(0) Or StartPoint(1) <> PtLast(1) Or StartPoint(2) <> PtLast(2) Then
       
        Call Rev_Draw(PtLast, StartPoint)
   
    End If

    Call Rev_Draw_Cloud
   
    For Cntr = 0 To UBound(CurrLin)
        CurrLin(Cntr).Delete
    Next Cntr
   
    Debug.Print Chr$(10) & "Polygon Cloud was Created Successfully :"

    Erase CurrLin
   
End Sub

Private Sub Rev_Draw(Point1 As Variant, Point2 As Variant)

Dim TempLine                                   As AcadLine
Dim Dist                                            As Double
Dim Angl                                           As Double
Dim NewCoordLength                       As Double
Dim VertPoints()                                As Double
Dim Arcs                                           As Integer
Dim Counter                                      As Integer
Dim Cntr                                            As Integer
Dim Cntr2                                          As Integer
Dim Increm                                        As Integer
Dim Point3                                         As Variant

    CoordLength = GetSetting("RevisionCloud", "Value", "SystemCoordLenght")
   
'Here is where the fun part occurs.

    Point1 = ThisDrawing.Utility.TranslateCoordinates(Point1, acUCS, acWorld, False)
   
    Point2 = ThisDrawing.Utility.TranslateCoordinates(Point2, acUCS, acWorld, False)
   
    Set TempLine = ThisDrawing.ModelSpace.AddLine(Point1, Point2)
    Dist = TempLine.Length
    Angl = TempLine.Angle
    TempLine.Delete
    Set TempLine = Nothing
   
    Arcs = (Fix(Dist) / CoordLength) + 1
    NewCoordLength = Dist / Arcs
    Counter = 0
    Increm = 2
       
    ReDim VertPoints(0 To 1)
    VertPoints(0) = Point1(0): VertPoints(1) = Point1(1)
   
    Do While Counter < Arcs
   
        ReDim Preserve VertPoints(0 To Increm + 1)
        Point3 = ThisDrawing.Utility.PolarPoint(Point1, Angl, NewCoordLength)
       VertPoints(Increm) = Point3(0): VertPoints(Increm + 1) = Point3(1)
        Increm = Increm + 2
        Counter = Counter + 1
        Point1(0) = Point3(0): Point1(1) = Point3(1): Point1(2) = Point3(2)
   
    Loop
   
On Error GoTo NewVariable

    Cntr2 = UBound(PolyVertIndex) + 1
    MainCntr = MainCntr + UBound(VertPoints) + 1
    GoTo ContinueAlong
   
NewVariable:
   
    Cntr2 = 0
    MainCntr = MainCntr + UBound(VertPoints)
   
ContinueAlong:
           
    ReDim Preserve PolyVertIndex(0 To MainCntr)
   
    For Cntr = 0 To UBound(VertPoints)
   
        PolyVertIndex(Cntr2) = VertPoints(Cntr)
        Cntr2 = Cntr2 + 1
       
    Next Cntr

    Erase VertPoints
    Erase Point3
   
End Sub

Private Sub Rev_Draw_Cloud()

Dim FinalLine                         As AcadLWPolyline
Dim BulgeH                            As Double
Dim VertCount                         As Integer
Dim Cntr                              As Integer
Dim CloudStart(0 To 2)          As Double

CloudStart(0) = PolyVertIndex(0): CloudStart(1) = PolyVertIndex(1): CloudStart(2) = 0

    VertCount = ((UBound(PolyVertIndex) + 1) / 2) - 1
   
    Set FinalLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(PolyVertIndex)
   
    'FinalLine.Rotate
   
    BulgeH = GetBulge(CoordLength) * -1
   
    For Cntr = 0 To VertCount
           
            FinalLine.SetBulge Cntr, BulgeH
           
    Next Cntr

    Set FinalLine = Nothing
   
End Sub

Private Sub Rev_Options()

    Rev_Cloud_Options.Show
   
End Sub

Private Function GetBulge(LOChord As Double) As Double

Dim Tri1Len                           As Double
Dim BulgeHeight                       As Double
Dim ChordEndAng                       As Double
Dim ChordHeightAng                    As Double
Dim AngleIncluded                     As Double
   
    Const PI = 3.1415926
   
    BulgeHeight = LOChord / 1.125
    Tri1Len = LOChord / 2
   
    ChordEndAng = Atn(Tri1Len / BulgeHeight)
    ChordEndAng = ChordEndAng * (180 / PI)
   
    ChordHeightAng = 180 - (ChordEndAng + 90)
    AngleIncluded = ((ChordHeightAng * 2) * (PI / 180))
       
    GetBulge = Tan(AngleIncluded / 4)
   
End Function


Let me add that this worked fine, until I started wanting it to work regardless of the current UCS, and added in all of the translate coordinates stuff.

Any help would be appreciated.