Message 1 of 4
Not applicable
03-21-2019
03:21 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi all,
I am not ashamed to admit this is well outside my understanding and am begging for help...
We draw polylines in model space and some users rotate their UCS (for viewport purposes) and all of a sudden, the polyline no longer consists of linesegments and the pick point becomes the endpoint of the polyline. I have found some code that has helped me sort of understand, but although the line works rotating correctly, it still goes to the end of the line.
Is there anyone here who can help me (not necessarily by giving me the answer) with the following things:
1. Why when the ucs is rotated around the Z axis, does the pick point not work and
2. Why does the polyline suddenly not consist of the same line segments it did when the ucs is not rotated?
My code is below (feel free to criticise):
Public Sub GetRot(ByVal sHType As String)
Dim oid As ObjectId
Dim iRot As Double
Dim pickPt As Point3d
Dim sp As Point2d
Dim ep As Point2d
Dim fine As Boolean = True
Dim isBlk As Boolean = False
Dim locked As New ObjectIdCollection()
Dim acLine As New Line
Dim pKeyOpts As PromptKeywordOptions = New PromptKeywordOptions("")
pKeyOpts.Message = vbLf & "Up (U) or Down (D) ? "
pKeyOpts.Keywords.Add("U")
pKeyOpts.Keywords.Add("D")
pKeyOpts.Keywords.Default = "U"
pKeyOpts.AllowNone = False
Dim pKO2 As PromptKeywordOptions = New PromptKeywordOptions("")
pKO2.Message = vbLf & "Invert (Y/N) ? "
pKO2.Keywords.Add("Y")
pKO2.Keywords.Add("N")
pKO2.Keywords.Default = "N"
pKO2.AllowNone = False
Using doc.LockDocument()
Dim pno As PromptNestedEntityOptions = New PromptNestedEntityOptions("" & vbLf & "Select Line ")
Dim nres As PromptNestedEntityResult = ed.GetNestedEntity(pno)
If (nres.Status <> PromptStatus.OK) Then
ed.WriteMessage("" & vbLf & "Selection failed")
Return
End If
Using tr As Transaction = db.TransactionManager.StartTransaction()
' try to unlock layers
Dim lt As LayerTable = DirectCast(tr.GetObject(db.LayerTableId, OpenMode.ForRead), LayerTable)
For Each ltId As ObjectId In lt
If ltId.IsValid AndAlso ltId.IsResident AndAlso Not ltId.IsErased Then
Dim ltr As LayerTableRecord = DirectCast(tr.GetObject(ltId, OpenMode.ForRead), LayerTableRecord)
If ltr.IsLocked Then
locked.Add(ltId)
ltr.UpgradeOpen()
ltr.IsLocked = False
End If
End If
Next
oid = nres.ObjectId
oEntHook = CType(tr.GetObject(oid, OpenMode.ForWrite), Entity)
Dim ctnIds() As ObjectId = nres.GetContainers()
If Not ctnIds.Length = 0 Then
If Not UCase(oEntHook.BlockName).Equals("*MODEL_SPACE") Then
Dim br As BlockReference = DirectCast(tr.GetObject(ctnIds(0), OpenMode.ForRead), BlockReference)
iRot = br.Rotation
isBlk = True
End If
End If
Try
Dim UCS As CoordinateSystem3d = ed.CurrentUserCoordinateSystem.CoordinateSystem3d
Dim OcsPlane As Plane = New Plane(Point3d.Origin, UCS.Zaxis)
Dim OCS As CoordinateSystem3d = Matrix3d.PlaneToWorld(OcsPlane).CoordinateSystem3d
Dim ucsRotation As Double = OCS.Xaxis.GetAngleTo(UCS.Xaxis)
Dim vec1 As Vector3d
Dim aa As Double
Select Case isBlk
Case False
Select Case True
Case TypeOf oEntHook Is Line
Dim oLine As Line = DirectCast(tr.GetObject(oEntHook.ObjectId, OpenMode.ForRead), Line)
pickPt = oLine.GetClosestPointTo(nres.PickedPoint, False)
vec1 = oLine.StartPoint.GetVectorTo(oLine.EndPoint)
aa = vec1.AngleOnPlane(OcsPlane)
ed.WriteMessage(vbLf & "Aa IS " & aa.ToString)
iRot = aa
Case TypeOf oEntHook Is Polyline
Dim pline As Polyline = DirectCast(tr.GetObject(oEntHook.ObjectId, OpenMode.ForRead, False), Polyline)
If pline IsNot Nothing Then
pickPt = pline.GetClosestPointTo(nres.PickedPoint, False)
Dim param As Double = pline.GetParameterAtPoint(pickPt)
Dim index As Integer = CInt(Math.Truncate(param))
Dim stype As SegmentType = pline.GetSegmentType(index)
ed.WriteMessage(stype.ToString)
If stype = SegmentType.Line Then
Dim lineseg As LineSegment2d = pline.GetLineSegment2dAt(index)
ed.WriteMessage(vbLf & index)
sp = lineseg.StartPoint
ep = lineseg.EndPoint
acLine = New Line(New Point3d(sp.X, sp.Y, 0), New Point3d(ep.X, ep.Y, 0))
'iRot = acLine.Angle
vec1 = acLine.StartPoint.GetVectorTo(acLine.EndPoint)
aa = vec1.AngleOnPlane(OcsPlane)
iRot = aa
Else
ed.WriteMessage("Why is it suddenly no longer a lineseg???")
End If
End If
End Select
ed.WriteMessage(vbLf & "PP = {0}", pickPt.ToString)
If iRot > funcGetRads(180) Then
iRot -= funcGetRads(180)
ElseIf iRot = 0 Then
'' I need a function to ask whether it is up or down on a zero line
Dim pKeyRes As PromptResult = ed.GetKeywords(pKeyOpts)
Select Case UCase(pKeyRes.StringResult)
Case "U"
Select Case sHType
Case "R" : iRot += funcGetRads(180)
End Select
Case "D"
Select Case sHType
Case "L" : iRot += funcGetRads(180)
End Select
End Select
ElseIf iRot = funcGetRads(180) Then
Dim pKeyRes As PromptResult = ed.GetKeywords(pKeyOpts)
Select Case UCase(pKeyRes.StringResult)
Case "U"
Select Case sHType
Case "L" : iRot -= funcGetRads(180)
End Select
Case "D"
Select Case sHType
Case "R" : iRot -= funcGetRads(180)
End Select
End Select
End If
End Select
iRot -= funcGetRads(90)
'End Select
ed.WriteMessage(vbLf & "LINE ANGLE IS " & funcGetDegrees(iRot).ToString)
Catch ex As System.Exception
ed.WriteMessage(vbLf & "Error: {0}" & vbLf & "Trace: {1}", ex.Message, ex.StackTrace)
Finally
For Each ltId As ObjectId In locked
Dim ltr As LayerTableRecord = DirectCast(tr.GetObject(ltId, OpenMode.ForWrite), LayerTableRecord)
ltr.IsLocked = True
Next
tr.Commit()
End Try
End Using
End Using
dHRot = iRot
ptH3d = pickPt
Return
End Sub
I am failing to wrap my head around why the rotation of the ucs affects these entities the way it is. What am I doing wrong here? The program works perfectly if the ucs is not rotated.
Thank you all in advance.
Solved! Go to Solution.
