Re: AcquirePoint
#17Hi,
Can you attach your code here then someone can find/debug where the issue does?
Can you attach your code here then someone can find/debug where the issue does?
Re: AcquirePoint
#18Code: Select all
Public Class MoveRotationScaleJig
Inherits DrawJig
#Region "Fields"
Private mBase As teigha.geometry.point3d
Protected mEntities As New List(Of Entity)()
Private mTotalJigFactorCount As Integer = 3
Private mCurJigFactorIndex As Integer = 1
' Jig Factor Index
Public mLocation As teigha.geometry.point3d
' Jig Factor #1
Public mAngle As [Double]
' Jig Factor #2
Public mScaleFactor As [Double]
' Jig Factor #3
#End Region
#Region "Constructors"
Public Sub New()
MyBase.New
'Dim _ed As Editor = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
'AddHandler _ed.PointMonitor, New PointMonitorEventHandler(AddressOf ed_PointMonitor)
End Sub
'Public Sub ed_PointMonitor(sender As Object, e As PointMonitorEventArgs)
' mLocation = e.Context.ComputedPoint
'End Sub
Public Sub New(basePt As Point3d)
mBase = basePt.TransformBy(UCS)
'TODO: Initialize jig factors and transform them if necessary.
mLocation = mBase
mAngle = 0
mScaleFactor = 1
End Sub
#End Region
#Region "Properties"
Public Property Location() As teigha.geometry.point3d
Get
Return mLocation
End Get
Set
mLocation = Value
End Set
End Property
Public Property Angle() As [Double]
Get
Return mAngle
End Get
Set
mAngle = Value
End Set
End Property
Public Property JigFactor As Integer
Get
Return mTotalJigFactorCount
End Get
Set(value As Integer)
mTotalJigFactorCount = value
End Set
End Property
Public Property ScaleFactor() As [Double]
Get
Return mScaleFactor
End Get
Set
mScaleFactor = Value
End Set
End Property
Public Property Base() As teigha.geometry.point3d
Get
Return mBase
End Get
Set
mBase = Value
End Set
End Property
Public ReadOnly Property AcEditor() As Editor
Get
Return MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
End Get
End Property
Public ReadOnly Property UCS() As Matrix3d
Get
Return AcEditor.CurrentUserCoordinateSystem
End Get
End Property
Public ReadOnly Property IcEditor As Editor
Get
Return IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
End Get
End Property
Public Property TotalJigFactor As Integer
Get
Return mTotalJigFactorCount
End Get
Set(value As Integer)
mTotalJigFactorCount = value
End Set
End Property
Public ReadOnly Property Transformation() As Matrix3d
Get
'return Matrix3d.Identity; //* Change it to anything else meaningful.
Return Matrix3d.Scaling(mScaleFactor, mLocation).PostMultiplyBy(Matrix3d.Rotation(mAngle, Vector3d.ZAxis.TransformBy(UCS), mLocation)).PostMultiplyBy(Matrix3d.Displacement(mBase.GetVectorTo(mLocation)))
End Get
End Property
Public Property Entities() As List(Of Entity)
Get
Return mEntities
End Get
Set(value As List(Of Entity))
mEntities = value
End Set
End Property
#End Region
#Region "Methods"
Public Sub AddEntity(ent As Entity)
ent.TransformBy(Intellicad.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.CurrentUserCoordinateSystem)
mEntities.Add(ent)
End Sub
Public Sub TransformEntities()
Dim mat As Matrix3d = Transformation
For Each ent As Entity In mEntities
ent.TransformBy(mat)
Next
End Sub
#End Region
#Region "Overrides"
Protected Overrides Function WorldDraw(draw As WorldDraw) As Boolean
Dim mat As Matrix3d = Transformation
Dim geo As WorldGeometry = draw.Geometry
If geo IsNot Nothing Then
geo.PushModelTransform(mat)
For Each ent As Entity In mEntities
geo.Draw(ent)
Next
geo.PopModelTransform()
End If
Return True
End Function
Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Select Case mCurJigFactorIndex
Case 1
Dim prOptions1 As New JigPromptPointOptions(vbLf & "Move:")
' Set properties such as UseBasePoint and BasePoint of the prompt options object if necessary here.
prOptions1.UserInputControls = UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect
'prOptions1.UserInputControls = UserInputControls.GovernedByUCSDetect Or UserInputControls.UseBasePointElevation Or UserInputControls.Accept3dCoordinates
prOptions1.UseBasePoint = False
Dim prResult1 As PromptPointResult = prompts.AcquirePoint(prOptions1)
If prResult1.Status = PromptStatus.Cancel AndAlso prResult1.Status = PromptStatus.[Error] Then
Return SamplerStatus.Cancel
End If
'If prResult1.Value.Equals(mLocation) Then
If Not mLocation.IsEqualTo(prResult1.Value, New Tolerance(0.000000001, 0.000000001)) Then
'Use better comparison method if necessary.
mLocation = prResult1.Value
Return SamplerStatus.OK
Else
Return SamplerStatus.NoChange
End If
Case 2
Dim prOptions2 As New JigPromptAngleOptions(vbLf & "Rotate:")
prOptions2.UseBasePoint = True
prOptions2.BasePoint = mLocation
prOptions2.UserInputControls = UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect
Dim prResult2 As PromptDoubleResult = prompts.AcquireAngle(prOptions2)
If prResult2.Status = PromptStatus.Cancel AndAlso prResult2.Status = PromptStatus.[Error] Then
Return SamplerStatus.Cancel
End If
If prResult2.Value.Equals(mAngle) Then
'Use better comparison method if necessary.
Return SamplerStatus.NoChange
Else
mAngle = prResult2.Value
Return SamplerStatus.OK
End If
Case 3
Dim prOptions3 As New JigPromptDistanceOptions(vbLf & "Scale:")
prOptions3.UseBasePoint = True
prOptions3.BasePoint = mLocation
prOptions3.UserInputControls = UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect
Dim prResult3 As PromptDoubleResult = prompts.AcquireDistance(prOptions3)
If prResult3.Status = PromptStatus.Cancel AndAlso prResult3.Status = PromptStatus.[Error] Then
Return SamplerStatus.Cancel
End If
If prResult3.Value.Equals(mScaleFactor) Then
'Use better comparison method if necessary.
Return SamplerStatus.NoChange
Else
mScaleFactor = prResult3.Value
Return SamplerStatus.OK
End If
Case Else
Exit Select
End Select
Return SamplerStatus.OK
End Function
#End Region
#Region "Commnads"
Public Sub Jig()
Try
If PrivateJig() Then
TransformEntities()
End If
Catch ex As System.Exception
IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(ex.ToString)
End Try
End Sub
Public Function PrivateJig() As Boolean
Try
Dim pr As PromptResult
Do
pr = AcEditor.Drag(Me)
' Keyword handling code
If pr.Status = PromptStatus.Keyword Then
Else
Me.mCurJigFactorIndex += 1
End If
Loop While (pr.Status <> PromptStatus.Cancel AndAlso pr.Status <> PromptStatus.[Error]) AndAlso Me.mCurJigFactorIndex <= Me.mTotalJigFactorCount
If Me.mCurJigFactorIndex = Me.mTotalJigFactorCount + 1 Then
Return True
Else
Return False
End If
Catch
Return False
End Try
End Function
#End Region
#Region "Commands"
<CommandMethod("TestMoveRotationScaleJig_Method")>
Public Shared Sub TestMoveRotationScaleJig_Method()
Dim Doc As Document = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = Doc.Database
Dim ed As Editor = MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
If Not Doc.IsActive Then
End If
Try
Dim selRes As PromptSelectionResult = ed.GetSelection()
If selRes.Status <> PromptStatus.OK Then
Return
End If
Dim prOpt As New PromptPointOptions(vbLf & "Base point:")
Dim pr As PromptPointResult = ed.GetPoint(prOpt)
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim jigger As New MoveRotationScaleJig(pr.Value)
Using tr As Transaction = db.TransactionManager.StartTransaction()
For Each id As ObjectId In selRes.Value.GetObjectIds()
Dim ent As Entity = DirectCast(tr.GetObject(id, Teigha.DatabaseServices.OpenMode.ForWrite), Entity)
jigger.AddEntity(ent)
Next
'jigger.Jig()
tr.Commit()
End Using
Catch ex As System.Exception
ed.WriteMessage(ex.ToString())
End Try
End Sub
Public Shared Sub MoveRotationScaleJig_Method(BasePoint As Point3d, Entities As List(Of ObjectId))
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor = MgdAcApplication.DocumentManager.MdiActiveDocument.Editor
Try
Dim jigger As New MoveRotationScaleJig(BasePoint)
Using tr As Transaction = db.TransactionManager.StartTransaction()
For Each id As ObjectId In Entities
Dim ent As Entity = DirectCast(tr.GetObject(id, teigha.DatabaseServices.OpenMode.ForWrite), Entity)
jigger.AddEntity(ent)
Next
'jigger.Jig()
tr.Commit()
End Using
Catch ex As System.Exception
ed.WriteMessage(ex.ToString())
End Try
End Sub
#End Region
End Class
Re: AcquirePoint
#19Code to create Pallete
Code: Select all
Private Sub LigaçõesToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles LigaçõesToolStripMenuItem1.Click
Hide()
CommandMethods.CreatePaletteLigacoes()
End Sub
Re: AcquirePoint
#20Code: Select all
Public Shared Sub CreatePaletteLigacoes()
Dim ps As IntelliCAD.Windows.PaletteSet
' ps = New Intellicad.Windows.PaletteSet("My Palette")
ps = New IntelliCAD.Windows.PaletteSet("Ligações", New System.Guid("F69E9148-2DF8-4911-8442-8C97AF23C2EE"))
ps.Style = IntelliCAD.Windows.PaletteSetStyles.ShowPropertiesMenu Or
IntelliCAD.Windows.PaletteSetStyles.ShowAutoHideButton Or
IntelliCAD.Windows.PaletteSetStyles.ShowCloseButton
'ps.Opacity = 90
'ps.Size = New System.Drawing.Size(250, 400)
' ps.MinimumSize = New System.Drawing.Size(225, 400)
'//ctrl.Dock = System.Windows.Forms.DockStyle.Fill
Dim uc1 As New ucLigacoes
Dim p1 As IntelliCAD.Windows.Palette = ps.Add("Ligações", uc1)
'//You may Or may Not need the below code for list/combo boxes to retain focus.
'ps.KeepFocus = True
ps.Visible = True
End Sub
Re: AcquirePoint
#21Hi,
Try to replace the Jig with this one:
and the command method:
Try to replace the Jig with this one:
Code: Select all
Public Function Jig() As Boolean
Try
Dim pr As PromptResult
Do
pr = AcEditor.Drag(Me)
' Keyword handling code
If pr.Status = PromptStatus.Keyword Then
Else
Me.mCurJigFactorIndex += 1
End If
Loop While (pr.Status <> PromptStatus.Cancel AndAlso pr.Status <> PromptStatus.[Error]) AndAlso Me.mCurJigFactorIndex <= Me.mTotalJigFactorCount
If Me.mCurJigFactorIndex = Me.mTotalJigFactorCount + 1 Then
Return True
Else
Return False
End If
Catch
Return False
End Try
End Function
Code: Select all
<CommandMethod("TestMoveRotationScaleJig")>
Public Shared Sub TestMoveRotationScaleJig_Method()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor = CadApp.DocumentManager.MdiActiveDocument.Editor
Try
Dim selRes As PromptSelectionResult = ed.GetSelection()
If selRes.Status <> PromptStatus.OK Then
Return
End If
Dim prOpt As New PromptPointOptions(vbLf & "Base point:")
Dim pr As PromptPointResult = ed.GetPoint(prOpt)
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim jigger As New MoveRotationScaleJig(pr.Value)
Using tr As Transaction = db.TransactionManager.StartTransaction()
For Each id As ObjectId In selRes.Value.GetObjectIds()
Dim ent As Entity = DirectCast(tr.GetObject(id, OpenMode.ForWrite), Entity)
jigger.AddEntity(ent)
Next
If jigger.Jig() Then
jigger.TransformEntities()
End If
tr.Commit()
End Using
Catch ex As System.Exception
ed.WriteMessage(ex.ToString())
End Try
End Sub
Re: AcquirePoint
#22Still same result ... unfortunately.
I saw your ScreenShot thousands of times ...
Here my ScreenShot:
https://drive.google.com/file/d/1aTQTMa ... sp=sharing
Check it out !!
I saw your ScreenShot thousands of times ...
Here my ScreenShot:
https://drive.google.com/file/d/1aTQTMa ... sp=sharing
Check it out !!