VBA UCS problem - draw line / 3dpolyline

[victos]

Hi,

I have a problem because I can not calculate correctly point P2 relative to local coordinate system.
The point is that the user indicates the P1 and P2 from P1 is located about 100 units in the axis X. How to draw a line from P1 to P2 but in a local coordinate system?

Please help

http://www.cadtutor.net/forum/showthread.php?55396-VBA-UCS-problem-draw-line-3dpolyline&p=375370#post375370[/img]

[Fatty]

Hi,

I have a problem because I can not calculate correctly point P2 relative to local coordinate system.
The point is that the user indicates the P1 and P2 from P1 is located about 100 units in the axis X. How to draw a line from P1 to P2 but in a local coordinate system?

Please help

http://www.cadtutor.net/forum/showthread.php?55396-VBA-UCS-problem-draw-line-3dpolyline&p=375370#post375370[/img]

See if this helps
Sorry no explantion

Sub Demo()
  
    Dim currUCS As AcadUCSs
            ' naming current UCS is not have a name
        On Error Resume Next '<-- to bypass if exist or (if ThisDrawing.GetVariable("ucsname") return empty string)
        
        With ThisDrawing
            
            Set currUCS = .UserCoordinateSystems.Add( _
                            .GetVariable("UCSORG"), _
                            .Utility.TranslateCoordinates(.GetVariable("UCSXDIR"), acUCS, acWorld, 0), _
                            .Utility.TranslateCoordinates(.GetVariable("UCSYDIR"), acUCS, acWorld, 0), _
                            "BoxUCS")
        

        .ActiveUCS = currUCS  '<--set as current UCS
        
        If Err Then Err.Clear
        
        On Error GoTo 0
        
    ZoomAll '<--optional, just for debugging
    
    Dim ortho As Variant
    
    ortho = .GetVariable("orthomode")
    
    .SetVariable "orthomode", 1 '<--set orthomode to ON
    
    Dim firstPoint As Variant
    
     Dim secondPoint As Variant
     
      Dim firstPontUcs As Variant
     
        firstPoint = .Utility.GetPoint(, "Enter a point: ") ''<--GetPoint is always return WCS coordinates of the point the AutoCAD user has selected.

         firstPontUcs = .Utility.TranslateCoordinates(firstPoint, acWorld, acUCS, False) '' <-- convert coordinates to current UCS just for dysplaying the rubber band correctly

       secondPoint = .Utility.GetPoint(firstPontUcs, "Specify second point: ")
    
      Dim lineObj As AcadLine
    
    Set lineObj = .ModelSpace.AddLine(firstPoint, secondPoint)
    
    .SetVariable "orthomode", ortho
    
End With

End Sub

fixo

[victos]

Thank you, but not quite what I meant.

How can I get secondPoint did not indicate the user, only that:
secondPoint (0) = firstPoint (0) + 100
secondPoint (1) = firstPoint (1)
secondPoint (2) = firstPoint (2)

It does not work

[Fatty]

Thank you, but not quite what I meant.

How can I get secondPoint did not indicate the user, only that:
secondPoint (0) = firstPoint (0) + 100
secondPoint (1) = firstPoint (1)
secondPoint (2) = firstPoint (2)

It does not work

Think the problem is on X-axis direction
Give this a try, not tested
See also TransformBy method to create objects in UCS

''--> Tools -> Options -> General -> Error Trapping ->check "Break on Unhandled Errors" radio button
Sub Ahha()

Dim msg As String

Dim i As Integer

   Dim firstPoint As Variant
         
ZoomAll '<--optional, just for debugging

With ThisDrawing.Utility

i = 0

On Error Resume Next

Do

msg = IIf(i > 0, vbCrLf & "Pick the next point (or Press Enter to Exit): ", vbCrLf & "Pick the first point:")

firstPoint = .GetPoint(, msg)

  If Err = 0 Then

    i = i + 1
    
        Dim xdir As Variant
        
        Dim ydir As Variant
        
        xdir = ThisDrawing.GetVariable("UCSXDIR")
        
        ydir = ThisDrawing.GetVariable("UCSYDIR")

       Dim PntToAdd(0 To 2) As Double
      
      PntToAdd(0) = 120
      
     PntToAdd(1) = 0#
     
    PntToAdd(2) = 0#
    
    PntToAdd(0) = PntToAdd(0) * CDbl(xdir(0))

   PntToAdd(1) = PntToAdd(1) * CDbl(ydir(1))
    
   
 Dim secondPoint(2) As Double
 
secondPoint(0) = firstPoint(0) + PntToAdd(0): secondPoint(1) = firstPoint(1) + PntToAdd(1): secondPoint(2) = firstPoint(2) + PntToAdd(2)
    
     Dim lineObj As AcadLine
    
      Set lineObj = ThisDrawing.ModelSpace.AddLine(firstPoint, secondPoint)
    
       With lineObj
       
   .Update
   
      MsgBox "Line length = " & vbTab & lineObj.Length & vbCr & _
      "START point: X= [" & Round(.startPoint(0), 3) & "] Y = " & Round(.startPoint(1), 3) & " Z = " & Round(.startPoint(2), 3) & vbCr & _
      "END point: X= [" & Round(.endPoint(0), 3) & "] Y = " & Round(.endPoint(1), 3) & " Z = " & Round(.endPoint(2), 3)
    
End With

    End If

Loop While Err = 0

End With

End Sub