Another DimOrdinate in UCS Question

[Anonymous]

Here is my situation I get four points in modelspace, while in the WCS,
that represent a 100,100 square with P1 being the lower left point. I
create a 10" dia. circle 75 units to the right of P1. I create an ordinate
dimension but it dimensions from 0,0 of the WCS. I want the dimension to be
relative to P1. I have seen threads saying that
ThisDrawing.Utility.TranslateCoordinates is required. I have tried using it
but am still not getting the results I want. Below is some code explained
in this thread. How would I apply ThisDrawing.Utility.TranslateCoordinates
to this code so that my ordinate dim be 75 instead of 425? Thanks.

Chris


Public Sub DimOrdinateTest()
Dim P1(2) As Double
Dim P2(2) As Double
Dim P3(2) As Double
Dim P4(2) As Double
Dim CirclePt(2) As Double
Dim MyLine As AcadLine
Dim MyCircle As AcadCircle
Dim MyDimOrdinate As AcadDimOrdinate
Dim MyUcs As AcadUCS
Dim currUCS As AcadUCS
Dim OrdPt1(2) As Double
Dim OrdPt2(2) As Double

P1(0) = -500: P1(1) = 500
P2(0) = -500: P2(1) = 600
P3(0) = -400: P3(1) = 600
P4(0) = -400: P4(1) = 500
CirclePt(0) = -425: CirclePt(1) = 500
OrdPt1(0) = CirclePt(0): OrdPt1(1) = CirclePt(1)
OrdPt2(0) = CirclePt(0): OrdPt2(1) = CirclePt(1) - 10

Set MyLine = ThisDrawing.ModelSpace.AddLine(P1, P2)
Set MyLine = ThisDrawing.ModelSpace.AddLine(P2, P3)
Set MyLine = ThisDrawing.ModelSpace.AddLine(P3, P4)
Set MyLine = ThisDrawing.ModelSpace.AddLine(P4, P1)
Set MyCircle = ThisDrawing.ModelSpace.AddCircle(CirclePt, 5#)

Set currUCS = ThisDrawing.ActiveUCS

On Error Resume Next
Set MyUcs = ThisDrawing.UserCoordinateSystems.Item("Temp")
If MyUcs Is Nothing Then
ThisDrawing.UserCoordinateSystems.Add P1, P4, P2, "Temp"
ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems("Temp")
Else
ThisDrawing.UserCoordinateSystems("Temp").Delete
ThisDrawing.UserCoordinateSystems.Add P1, P4, P2, "Temp"
ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems("Temp")
End If

Set MyDimOrdinate = ThisDrawing.ModelSpace.AddDimOrdinate(OrdPt1, OrdPt2,
True)

ThisDrawing.ActiveUCS = currUCS
End Sub

[Anonymous]

Round 2

I found using SendCommand below I am able to get the intended results.
Can/should this be done w/o having to use SendCommand?

Chris

Public Sub DimOrdinateTest()
Dim P1(2) As Double
Dim P2(2) As Double
Dim P3(2) As Double
Dim P4(2) As Double
Dim CirclePt(2) As Double
Dim MyLine As AcadLine
Dim MyCircle As AcadCircle
Dim MyDimOrdinate As AcadDimOrdinate
Dim MyUcs As AcadUCS
Dim currUCS As AcadUCS
Dim OrdPt1(2) As Double
Dim OrdPt2(2) As Double
Dim x1 As Variant
Dim x2 As Variant

P1(0) = -500: P1(1) = 500
P2(0) = -500: P2(1) = 600
P3(0) = -400: P3(1) = 600
P4(0) = -400: P4(1) = 500
CirclePt(0) = -425: CirclePt(1) = 500
OrdPt1(0) = CirclePt(0): OrdPt1(1) = CirclePt(1)
OrdPt2(0) = CirclePt(0): OrdPt2(1) = CirclePt(1) - 10

Set MyLine = ThisDrawing.ModelSpace.AddLine(P1, P2)
Set MyLine = ThisDrawing.ModelSpace.AddLine(P2, P3)
Set MyLine = ThisDrawing.ModelSpace.AddLine(P3, P4)
Set MyLine = ThisDrawing.ModelSpace.AddLine(P4, P1)
Set MyCircle = ThisDrawing.ModelSpace.AddCircle(CirclePt, 5#)

ThisDrawing.SendCommand "ucs" & vbCr & "n" & vbCr & P1(0) & "," & P1(1) &
vbCr
x1 = ThisDrawing.Utility.TranslateCoordinates(OrdPt1, acWorld, acUCS,
False)
x2 = ThisDrawing.Utility.TranslateCoordinates(OrdPt2, acWorld, acUCS,
False)

ThisDrawing.SendCommand "dim1" & vbCr & "ord" & vbCr & x1(0) & "," & x1(1) &
vbCr & x2(0) & "," & x2(1) & vbCr & vbCr

ThisDrawing.SendCommand "ucs" & vbCr & vbCr
End Sub


"Chris Picklesimer" wrote in message
news:4A0FA977797091B8C60302779760E04A@in.WebX.maYIadrTaRb...
> Here is my situation I get four points in modelspace, while in the WCS,
> that represent a 100,100 square with P1 being the lower left point. I
> create a 10" dia. circle 75 units to the right of P1. I create an
ordinate
> dimension but it dimensions from 0,0 of the WCS. I want the dimension to
be
> relative to P1. I have seen threads saying that
> ThisDrawing.Utility.TranslateCoordinates is required. I have tried using
it
> but am still not getting the results I want. Below is some code explained
> in this thread. How would I apply
ThisDrawing.Utility.TranslateCoordinates
> to this code so that my ordinate dim be 75 instead of 425? Thanks.
>
> Chris
>
>
> Public Sub DimOrdinateTest()
> Dim P1(2) As Double
> Dim P2(2) As Double
> Dim P3(2) As Double
> Dim P4(2) As Double
> Dim CirclePt(2) As Double
> Dim MyLine As AcadLine
> Dim MyCircle As AcadCircle
> Dim MyDimOrdinate As AcadDimOrdinate
> Dim MyUcs As AcadUCS
> Dim currUCS As AcadUCS
> Dim OrdPt1(2) As Double
> Dim OrdPt2(2) As Double
>
> P1(0) = -500: P1(1) = 500
> P2(0) = -500: P2(1) = 600
> P3(0) = -400: P3(1) = 600
> P4(0) = -400: P4(1) = 500
> CirclePt(0) = -425: CirclePt(1) = 500
> OrdPt1(0) = CirclePt(0): OrdPt1(1) = CirclePt(1)
> OrdPt2(0) = CirclePt(0): OrdPt2(1) = CirclePt(1) - 10
>
> Set MyLine = ThisDrawing.ModelSpace.AddLine(P1, P2)
> Set MyLine = ThisDrawing.ModelSpace.AddLine(P2, P3)
> Set MyLine = ThisDrawing.ModelSpace.AddLine(P3, P4)
> Set MyLine = ThisDrawing.ModelSpace.AddLine(P4, P1)
> Set MyCircle = ThisDrawing.ModelSpace.AddCircle(CirclePt, 5#)
>
> Set currUCS = ThisDrawing.ActiveUCS
>
> On Error Resume Next
> Set MyUcs = ThisDrawing.UserCoordinateSystems.Item("Temp")
> If MyUcs Is Nothing Then
> ThisDrawing.UserCoordinateSystems.Add P1, P4, P2, "Temp"
> ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems("Temp")
> Else
> ThisDrawing.UserCoordinateSystems("Temp").Delete
> ThisDrawing.UserCoordinateSystems.Add P1, P4, P2, "Temp"
> ThisDrawing.ActiveUCS = ThisDrawing.UserCoordinateSystems("Temp")
> End If
>
> Set MyDimOrdinate = ThisDrawing.ModelSpace.AddDimOrdinate(OrdPt1, OrdPt2,
> True)
>
> ThisDrawing.ActiveUCS = currUCS
> End Sub
>
>