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

0 Members and 1 Guest are viewing this topic.


  • 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?


  • Seagull
  • Posts: 17665
  • Have thousands of dwgs to process? Contact me.
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?
Engineering Technologist CAD Specialist Programmer Analyst
Design Drafting Document Control Automation.

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


  • 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:


  • 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


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
        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
            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


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)
    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)
            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

            Cont = False
        End If

    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)
    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
    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)
On Error GoTo NewVariable

    Cntr2 = UBound(PolyVertIndex) + 1
    MainCntr = MainCntr + UBound(VertPoints) + 1
    GoTo ContinueAlong
    Cntr2 = 0
    MainCntr = MainCntr + UBound(VertPoints)
    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)
    BulgeH = GetBulge(CoordLength) * -1
    For Cntr = 0 To VertCount
            FinalLine.SetBulge Cntr, BulgeH
    Next Cntr

    Set FinalLine = Nothing
End Sub

Private Sub Rev_Options()

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.