AcquirePoint

#1
AcquirePoint called from JigPrompts doesn't accept osnap ...
OSNAP only work when you call CaommandMethod, not work when is called from a internal VB function ...

Is there any way to make this work ? Was it changed in ICAD PE10 ?

Code: Select all

Protected Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
            Try

                Select Case mCurJigFactorIndex
                    Case 1
                        Dim prOptions1 As New JigPromptPointOptions
                        ' Set properties such as UseBasePoint and BasePoint of the prompt options object if necessary here.
                        prOptions1.UserInputControls = UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect Or
                            UserInputControls.Accept3dCoordinates Or UserInputControls.NullResponseAccepted
                        prOptions1.UseBasePoint = True
                        prOptions1.BasePoint = Base
                        prOptions1.UseRubberBand = False
                        prOptions1.Message = vbLf & "Mover>"

                        Dim prResult1 As PromptPointResult = prompts.AcquirePoint(prOptions1)

                        If prResult1.Status = PromptStatus.Keyword Then

                            Return SamplerStatus.OK
                        End If

                        If prResult1.Status = PromptStatus.Cancel Then
                            Location = Base
                            Return SamplerStatus.Cancel
                        End If


                        If Base.DistanceTo(prResult1.Value) < Tolerance.Global.EqualPoint Then
                            'Use better comparison method if necessary.
                            Return SamplerStatus.NoChange
                        Else
                            Location = prResult1.Value

                            Return SamplerStatus.OK
                        End If

                    Case 2
                        Dim prOptions2 As New JigPromptAngleOptions

                        prOptions2.UseBasePoint = True
                        prOptions2.BasePoint = Location
                        prOptions2.DefaultValue = 0
                        prOptions2.UserInputControls = UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect Or
                            UserInputControls.Accept3dCoordinates Or UserInputControls.NullResponseAccepted
                        prOptions2.Message = vbLf & "Rotacionar>"

                        Dim prResult2 As PromptDoubleResult = prompts.AcquireAngle(prOptions2)

                        If prResult2.Status = PromptStatus.Keyword Then

                            Return SamplerStatus.OK
                        End If

                        If prResult2.Status = PromptStatus.Cancel Then
                            Angulo = Angle
                            Return SamplerStatus.Cancel
                        End If

                        If prResult2.Status <> PromptStatus.OK Then
                            Return SamplerStatus.Cancel
                        End If

                        If prResult2.Value.Equals(mAngle) Then
                            'Use better comparison method if necessary.
                            Return SamplerStatus.NoChange
                        Else
                            Angle = prResult2.Value
                            Angulo = Angle
                            Return SamplerStatus.OK
                        End If

                    Case 3
                        Dim prOptions3 As New JigPromptDistanceOptions

                        'prOptions3.SetMessageAndKeywords("Escala [Sim/Não]", "Sim Não")
                        prOptions3.Message = vbLf & "Escalar>"
                        prOptions3.UseBasePoint = False
                        prOptions3.BasePoint = mLocation
                        prOptions3.UserInputControls = UserInputControls.GovernedByOrthoMode Or UserInputControls.GovernedByUCSDetect
                        Dim prResult3 As PromptDoubleResult = prompts.AcquireDistance(prOptions3)

                        If prResult3.Status = PromptStatus.Keyword Then
                            'Select Case prResult3.StringResult
                            '    Case "Sim"
                            '        mScaleFactor = prResult3.Value
                            '    Case "Não"
                            '        mScaleFactor = 1
                            'End Select

                            Return SamplerStatus.OK
                        End If

                        If prResult3.Status = PromptStatus.Cancel Then
                            mScaleFactor = 1
                            Return SamplerStatus.OK
                        End If

                        If 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
                        Return SamplerStatus.OK
                    Case Else

                        Exit Select
                End Select
            Catch ex As system.Exception
                MsgBox(ex.Message, MsgBoxStyle.Critical, "Erro")
            End Try

            Return SamplerStatus.OK
        End Function

Re: AcquirePoint

#3
Try this called from a button click on User Control Form

Code: Select all

Public Shared Sub TestMoveRotationScaleJig_Method()
            Dim db As Database = IntelliCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
            Dim ed As Editor = MgdAcApplication.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, Teigha.DatabaseServices.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

#4
DenisSilveira wrote:
Tue Jun 01, 2021 7:12 pm
AcquirePoint called from JigPrompts doesn't accept osnap ...
OSNAP only work when you call CaommandMethod, not work when is called from a internal VB function ...

Is there any way to make this work ? Was it changed in ICAD PE10 ?

......
Yes, It works in IntelliCAD PE10+, both of CommandMethod and call from an internal function.

Code: Select all

    Private Sub MoveBt_Click(sender As Object, e As EventArgs) Handles MoveBt.Click
        Dim doc As Document = CadApp.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor

        ed.Command("TestMoveRotationScaleJig_Method")
    End Sub

    Private Sub MoveFunctionBt_Click(sender As Object, e As EventArgs) Handles MoveFunctionBt.Click
        Try
            TestMoveRotationScaleJig_Method()
        Catch ex As Exception
            CadApp.ShowAlertDialog(ex.Message)
        End Try

    End Sub

Re: AcquirePoint

#11
Downloading API 10.0 PE Plus x64 Date:17 December 2020 CMS IntelliCAD Premium Edition Plus (PE Plus) Developer API.

Checking my version, but I believe when I upgrade to version 10 API was upgraded too ...

Checking App version to NETFrameWork version 4.7.2

References IcCoreMgd_20.12_15, IcMgd_20.12_15, TD_Mgd_20.12_15 all Copy Local False options.

DLL files C:\Program Files\CMS\CMS IntelliCAD 10.0 Premium Edition Plus\*.dll

Also, tried ExJig.cs at NetAPI DotNetExamples, to check if my JIG code has some mistake or missing, but same result ...

Re: AcquirePoint

#12
Also changed my PalleteSet calling code as dotNetExamples:

Code: Select all

Public Shared Sub CreatePalettePerfil()
        Dim ps As IntelliCAD.Windows.PaletteSet


        If mobjPaletteSet Is Nothing Then


            Try
                mobjPaletteSet = New PaletteSet("DESENHAR", New System.Guid("F69E9148-2DF8-4911-8442-8C97AF23C2EE"))
                mobjPaletteSet.Style = PaletteSetStyles.ShowCloseButton Or PaletteSetStyles.ShowAutoHideButton
                mobjPaletteSet.Dispatcher.Invoke(New Action(Sub()
                                                                UCDesenhar = New ctrDesenhar()
                                                            End Sub))

                mobjPaletteSet.Dispatcher.Invoke(New Action(Sub()
                                                                UCMarca = New ucMarcas()
                                                            End Sub))
                mobjPaletteSet.Add("Perfil de Aço", UCDesenhar)
                mobjPaletteSet.Add("Marcas", UCMarca)
                mobjPaletteSet.Activate(0)
                mobjPaletteSet.AutoRollUp = True


                mobjPaletteSet.Visible = True

            Catch objError As System.Exception
                Dim xx As System.Exception = objError
            End Try
        Else

            mobjPaletteSet.Dispatcher.Invoke(New Action(Sub()
                                                            mobjPaletteSet.Visible = True
                                                        End Sub))

        End If

        '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


        '//You may Or may Not need the below code for list/combo boxes to retain focus.
        'ps.KeepFocus = True

    End Sub
And Up code is called inside menu bar at WindowsForm

Code: Select all

 Private Sub PerfisToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PerfisToolStripMenuItem.Click
        Hide()

        CommandMethods.CreatePalettePerfil()
    End Sub
UcControl "ctrDesenhar" has a button to insert / draw an object. After that MoveRotateScaleJig is called.

Re: AcquirePoint

#13
Try this:
replace Dim myPalette As MyPalette = New MyPalette() with you palette control

Code: Select all

    Public Sub ShowMyPalette()
        If myPaletteSet Is Nothing Then
            myPaletteSet = New PaletteSet("My Palette", New System.Guid("F69E9148-2DF8-4911-8442-8C97AF23C2EE"))
            myPaletteSet.MinimumSize = New System.Drawing.Size(300, 400)
            myPaletteSet.Style = PaletteSetStyles.ShowCloseButton Or PaletteSetStyles.ShowAutoHideButton

            Dim myPalette As MyPalette = New MyPalette() ' replace with you palette
            myPaletteSet.Add("Your palette name", myPalette)
        End If
        myPaletteSet.Visible = True

        myPaletteSet.Dock = DockSides.None

    End Sub

Re: AcquirePoint

#14
Used this ... same problem ... I believe some detail is the problem ... missing something little ...

Code: Select all

 Public Shared Sub CreatePalettePerfil()
        If myPaletteSet Is Nothing Then
            myPaletteSet = New PaletteSet("My Palette", New System.Guid("F69E9148-2DF8-4911-8442-8C97AF23C2EE"))
            myPaletteSet.MinimumSize = New System.Drawing.Size(300, 400)
            myPaletteSet.Style = PaletteSetStyles.ShowCloseButton Or PaletteSetStyles.ShowAutoHideButton

            Dim ctrDes As ctrDesenhar = New ctrDesenhar() ' replace with you palette
            Dim ucMar As ucMarcas = New ucMarcas

            myPaletteSet.Add("METÁLICA", ctrDes)
            myPaletteSet.Add("Marcas", ucMar)

        End If

        myPaletteSet.Visible = True

        myPaletteSet.Dock = DockSides.None
    End Sub