Need help making a cirlce Jig. Everthing works great in WCS system. When I switch to different UCS's the Circle is off and the Dimension is way off.
The weird thing is that I get funny results from this. I don't get the right Coordinates.
Dim
dres As PromptPointResult = prompts.AcquirePoint(jigOpts)
code:
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD
Imports System.Data
Public Class MyCircle
Public Class PipingJig
Inherits EntityJig
Dim BasePT As Point3d
Dim PtFloat As Point3d
Dim PtFloat2 As Point3d
Dim Vec2 As Vector3d
Private m_dims As DynamicDimensionDataCollection
Private m_Distance As Double
Public Property Distance() As Double
Get
Return m_Distance
End Get
Set(ByVal value As Double)
m_Distance = value
End Set
End Property
Public Sub New(ByVal StartPoint As Point3d, ByVal vec As Vector3d)
MyBase.New(New Circle(StartPoint, vec, 0.0001))
BasePT = StartPoint
vec = Vec2
m_dims = New DynamicDimensionDataCollection()
Dim dim2 As Dimension = New AlignedDimension()
dim2.SetDatabaseDefaults()
m_dims.Add(New DynamicDimensionData(dim2, True, True))
m_dims(0).Focal = True
m_dims(0).Editable = True
dim2.DynamicDimension = True
End Sub
Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
Dim jigOpts As New JigPromptPointOptions()
jigOpts.UserInputControls = (UserInputControls.GovernedByUCSDetect And UserInputControls.UseBasePointElevation Or UserInputControls.InitialBlankTerminatesInput)
jigOpts.Message = vbLf & "pick point"
jigOpts.BasePoint = BasePT
jigOpts.UseBasePoint = True
Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
'Gets WCS of the point
Dim PointTemp As Point3d = dres.Value
If PointTemp <> PtFloat Then
PtFloat = PointTemp
Else
Return SamplerStatus.NoChange
End If
Return SamplerStatus.OK
End Function
Protected Overrides Function Update() As Boolean
Try
Dim entcir As Circle = DirectCast(Entity, Circle)
Dim Dist As Double = BasePT.DistanceTo(PtFloat)
entcir.Radius = Dist
Thisdoc.MyTools.Editor(BasePT.X & "," & BasePT.Y & "," & BasePT.Z & " = " & PtFloat.X & "," & PtFloat.Y & "," & PtFloat.Z & " = " & Dist)
UpdateDimensions()
Catch generatedExceptionName As System.Exception
Return False
End Try
Return True
End Function
Protected Overrides Function GetDynamicDimensionData(ByVal dimScale As Double) As DynamicDimensionDataCollection
Return m_dims
End Function
Protected Overrides Sub OnDimensionValueChanged(ByVal e As Autodesk.AutoCAD.DatabaseServices.DynamicDimensionChangedEventArgs)
Distance = e.Value
End Sub
Private Sub UpdateDimensions()
Dim Dim2 As AlignedDimension = DirectCast(m_dims(0).Dimension, AlignedDimension)
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim matUCS As Matrix3d = ed.CurrentUserCoordinateSystem.Inverse
Dim TempBasePT As Point3d = BasePT.TransformBy(matUCS)
Dim TempPtFloat As Point3d = BasePT.TransformBy(matUCS)
Dim2.XLine1Point = TempBasePT
Dim2.XLine2Point = TempPtFloat
Dim2.DimLinePoint = TempBasePT
'Dim matUCS As Matrix3d = ed.CurrentUserCoordinateSystem
'Dim2.TransformBy(matUCS)
End Sub
Public Function GetEntity() As Entity
Return Entity
End Function
Protected Overrides Sub Finalize()
MyBase.Finalize()
End Sub
End Class
<CommandMethod("mycir")> _
Public Shared Sub DoIt()
Dim x As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsxdir
Dim y As Vector3d = Application.DocumentManager.MdiActiveDocument.Database.Ucsydir
Dim NormalVec As Vector3d = x.CrossProduct(y)
Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
Dim tm As Autodesk.AutoCAD.DatabaseServices.TransactionManager = db.TransactionManager
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
' setup the Command line prompt string
Dim prPointOptions As PromptPointOptions = New PromptPointOptions(vbCrLf & "Get Base Point")
Dim prPointRes As PromptPointResult
prPointRes = ed.GetPoint(prPointOptions)
' lets check the return status, if it's not ok simply return
If prPointRes.Status <> PromptStatus.OK Then
Exit Sub
End If
Dim matUCS As Matrix3d = ed.CurrentUserCoordinateSystem
Dim pt1 As Point3d = prPointRes.Value.TransformBy(matUCS)
Dim jig As New PipingJig(pt1, NormalVec.GetNormal())
'first call drag to get the major axis
Dim pr As PromptPointResult = Application.DocumentManager.MdiActiveDocument.Editor.Drag(jig)
Select Case pr.Status
Case PromptStatus.Cancel
Exit Sub
Case PromptStatus.OK
'Append entity.
Using myT As Transaction = tm.StartTransaction()
Dim bt As BlockTable = DirectCast(tm.GetObject(db.BlockTableId, OpenMode.ForRead, False), BlockTable)
Dim btr As BlockTableRecord = DirectCast(tm.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite, False), BlockTableRecord)
btr.AppendEntity(jig.GetEntity())
tm.AddNewlyCreatedDBObject(jig.GetEntity(), True)
myT.Commit()
End Using
End Select
End Sub
End Class
