---

  Hallo, an Alle Profis,

ich möchte etwas was bisher eine normale GetPoint-Anfrage war auf Jig umstellen.
Dazu wird aus:
  Dim myPDO As New PromptPointOptions(Myprompt)
wird zu:
Dim myPDO As New EditorInput.JigPromptPointOptions(Myprompt)
Bisher war es möglich, daß der User mit Return geantwortet hat. Dazu stand da:
        myPDO.AllowNone = True
Ist sowas bei JigPromptPointOptions auch möglich?
Schlüsselworte und Esc funktioniert, aber für nur Return habe ich keine Lösung gefunden.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

gefällt Dir das? 

Code:

---

Dim tOpts As JigPromptPointOptions = New JigPromptPointOptions("Punkt zeigen: ")
tOpts.DefaultValue = New Geometry.Point3d(0,0,0)  'Vorgabewert bei nur <ENTER>
tOpts.UserInputControls = UserInputControls.NullResponseAccepted
Dim myPPR As PromptPointResult = prompts.AcquirePoint(tOpts)

---

- alfred -

------------------
www.hollaus.at

---

Ja, das hilft mir sehr. Da sind auch noch mehr Einstellmöglichkeiten.

Danke, Theo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Alfred,

jetzt habe ich doch noch ein Problem bei dem ich nicht weiterkomme.
Ich benutze:
        myPDO.UseBasePoint = True
        myPDO.BasePoint = New Geometry.Point3d(Point1(0), Point1(1), Point1(2))
um einen Basispunkt zu verwenden.
Dann starte ich das Jig:
        Dim SelPt As EditorInput.PromptPointResult
        SelPt = myJig.BeginJig()
Dann pasiert bei der ACAD-Anfrage folgendes.
Mein Block(Jig) hängt wie gewünscht an der Maus. Und auch der Basispunkt wird verwendet, das bemerkt man am Verhalten wenn Orto an ist. Aber es wird keine Verbindungslinie zwischen dem Basispunkt und der Maus gezogen.
Wird diese durch das Jig überschrieben? Kann ich die Verbindungslinie trotzdem irgendwie anzeigen?

Danke Theo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

die wenigen Zeilen des Codes, die Du zeigst, reichen mir leider nicht, um da effizient einzugreifen.

Für die Darstellung von Drag(-Linien) gibt es ein ausführliches Beispiel für JIG >>>hier<<<.

Hier wird ganz genau gezeigt, wie Du mit der Basisklasse  Autodesk.AutoCAD.EditorInput.DrawJig  Deine DRAG-Linie angezeigt bekommst.

Das sollte helfen (hoffe ich mal), wenn nicht, dann nicht nur einzelne Zeilen Deines Codes, wo sollte ich denn da ansetzen?

- alfred -

------------------
www.hollaus.at

---

Guten Morgen Alfred,
mal Grundsätzlich die Frage, würde es gehen so wie ich es vorhabe, die Draglinie mit der Usebasepoint-Funktion vom PromptPointResult
darzustellen und gleichzeitig den Block als Jig an die Maus zu hängen.
Oder muß ich dann beides als Jig darstellen?

Mit der Draw Jig krieg ich die Linie hin. Aber wie kann ich beides schaffen Draglinie vom Basepoint und Block an der Maus.

Mehr Zeilen vom Code sind unten. Entschuldige das Chaos. Da ist viel zusammen kopiert.

Gruß Theo

Die Jig-Klasse:
Public Class AU_BlockJig
    Inherits Autodesk.AutoCAD.EditorInput.EntityJig
    Dim BasePt As Point3d = New Point3d(0, 0, 0)
    Dim myMatrix As Matrix3d
    Dim myBRef As DatabaseServices.BlockReference
    Public myOpts As EditorInput.JigPromptPointOptions
    Public xvonMaus As Double
    Dim yvonMaus As Double
    Dim AnFrage As String

    Sub New(ByVal BlockIns As Point3d, ByVal BlockID As ObjectId, ByVal Rotation As Double, ByVal Scale As Double, ByVal x As Double, ByVal y As Double, ByVal Frage As String)
        MyBase.New(New DatabaseServices.BlockReference(BlockIns, BlockID))
        myBRef = Me.Entity
        myBRef.Rotation = Rotation
        myBRef.ScaleFactors = New Geometry.Scale3d(Scale, Scale, Scale)
        xvonMaus = x
        yvonMaus = y
        Anfrage = Frage
    End Sub

    Function BeginJig() As PromptPointResult
        If myOpts Is Nothing Then
            myOpts = New EditorInput.JigPromptPointOptions()
            myOpts.Message = vbCrLf & AnFrage
            myOpts.Cursor = EditorInput.CursorType.Crosshair
            myOpts.UseBasePoint = False
        End If

        Dim ed As EditorInput.Editor = _
            Application.DocumentManager.MdiActiveDocument.Editor
        Dim myPR As PromptResult
        myPR = ed.Drag(Me)
        Return myPR
        'Do
        '    Select Case myPR.Status
        '        Case EditorInput.PromptStatus.OK
        '            Return myPR
        '            Exit Do
        '        Case EditorInput.PromptStatus.None
        '            Return myPR
        '            Exit Do
        '        Case EditorInput.PromptStatus.Keyword
        '            Return myPR
        '            Exit Do
        '        Case EditorInput.PromptStatus.Other
        '            Return myPR
        '            Exit Do
        '    End Select
        'Loop While myPR.Status <> EditorInput.PromptStatus.Cancel
        'Return Nothing
    End Function
    Protected Overrides Function Sampler(ByVal prompts As JigPrompts) _
        As SamplerStatus
        Dim myPPR As PromptPointResult
        Dim newpoint As Point3d
        myPPR = prompts.AcquirePoint(myOpts)
        Dim curPos As Point3d
        curPos = myPPR.Value

        If curPos.IsEqualTo(BasePt) Then
            Return SamplerStatus.NoChange
        Else
            newpoint = New Geometry.Point3d(myPPR.Value.X + 1000, myPPR.Value.Y - 200, myPPR.Value.Z)
            myMatrix = Geometry.Matrix3d.Displacement( _
                BasePt.GetVectorTo(newpoint))
            BasePt = myPPR.Value
            Return SamplerStatus.OK
        End If
    End Function

    Protected Overrides Function Update() As Boolean
        myBRef.Position = getTransformedInsPnt(BasePt)
        Return False
    End Function
    Public Function getTransformedInsPnt(ByVal BasePt As Geometry.Point3d) As Geometry.Point3d
        'hier ermitteln wir den Blockeinfügepunkt, abgeleitet aus Mausposition und Versatz in Y-Richtung
        Return New Geometry.Point3d(BasePt.X + xvonMaus, BasePt.Y + yvonMaus, BasePt.Z)

    End Function

End Class

Mein Aufruf im Program:

Sub Zweiter()
        Dim Testblock As AcadBlock
        Dim Win As Double
        Dim myEditor As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
        Dim Myprompt As String
        If Winkel = 0 Then Myprompt = vbNewLine + "Zweiten Punkt angeben[Return = Wechsel Senkrecht/WAAGERECHT]:"
        If Winkel = 90 Then Myprompt = vbNewLine + "Zweiten Punkt angeben[Return = Wechsel SENKRECHT/Waagerecht]:"
        Dim myPDO As New EditorInput.JigPromptPointOptions(Myprompt)
        myPDO.UseBasePoint = True
        myPDO.UserInputControls = UserInputControls.NullResponseAccepted
        myPDO.BasePoint = New Geometry.Point3d(Point1(0), Point1(1), Point1(2))
        myPDO.Keywords.Add("X Wechsel")
        Datei = FindDatei()
        Try
            Testblock = ThisDrawing.Blocks.Item(Datei)
        Catch ex As Exception
            AcadDoc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim tDB As Database = New Database(False, True)
            tDB.ReadDwgFile(Pfad & Datei & Dateiendung, IO.FileShare.Read, True, "")
            AcadDoc.Database.Insert(Datei, tDB, False)
            If tDB IsNot Nothing Then tDB.CloseInput(True) : tDB.Dispose() : tDB = Nothing
        End Try
        Win = Winkel * Pi / 180
        Dim myDB As Database
        myDB = HostApplicationServices.WorkingDatabase
        Dim myJig As AU_BlockJig
        Using myTrans As Transaction = myDB.TransactionManager.StartTransaction
            Dim myBT As BlockTable = myDB.BlockTableId.GetObject(OpenMode.ForRead)
            Dim myBTR As BlockTableRecord = _
                myBT(Datei).GetObject(OpenMode.ForRead)
            myJig = New AU_BlockJig(New Geometry.Point3d(0, 0, 0), _
                myBTR.ObjectId, Win, Faktor, 0, 0, "")
            myJig.myOpts = myPDO
        End Using
        Dim SelPt As EditorInput.PromptPointResult
        SelPt = myJig.BeginJig()
        If Not SelPt Is Nothing Then
            Select Case SelPt.Status
                Case EditorInput.PromptStatus.None
                    If Winkel = 0 Then
                        Winkel = 90
                    Else : Winkel = 0
                    End If
                    Zweiter()
                Case EditorInput.PromptStatus.Keyword
                    If Winkel = 0 Then
                        Winkel = 90
                    Else : Winkel = 0
                    End If
                    Zweiter()
                Case EditorInput.PromptStatus.OK
                    Point1(3) = SelPt.Value.X
                    Point1(4) = SelPt.Value.Y
                    Point1(5) = 0
                    Dim SPunkt(2) As Double
                    SPunkt(0) = LP.X
                    SPunkt(1) = LP.Y
                    SPunkt(2) = LP.Z
                    Dim EPunkt(2) As Double
                    EPunkt(0) = SelPt.Value.X
                    EPunkt(1) = SelPt.Value.Y
                    EPunkt(2) = SelPt.Value.Z

                    FührungsWinkel = ThisDrawing.Utility.AngleFromXAxis(SPunkt, EPunkt)

                    LP = New Geometry.Point3d(SelPt.Value.X, SelPt.Value.Y, SelPt.Value.Z)
                    MyLine = ThisDrawing.ActiveLayout.Block.AddPolyline(Point1)
                    Weiterer()
                Case EditorInput.PromptStatus.Other
                    Exit Sub
            End Select
        End If

    End Sub

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ErsteAnfrage.zip

Hallo Alfred,
anbei noch was zur Info. Das ganze ist ein größeres Projekt.
Bei dem zuerst eine Userform angezeigt wird und dann der Ablauf wie auf dem beiliegenden Word-Dokument sein soll. Sinn ist es einen Block mit Attributen einzufügen. mit oder ohne Führungslinie. waagerecht oder senkrecht. Da diese Funktion oft benötigt wird, ist der hohe Aufwand mit Jig und Führungslinie gerechtfertigt.
Ich hab das Ganze noch um "zurück" erweitert.

Gruß, Theo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

kurze Frage: hast Du das PDF in meinem obigen Link mal durchgelesen und probiert?
Ich meine, da steht alles, was Du brauchst.

- alfred -

------------------
www.hollaus.at

---

Hi Alfred,

hab  ich durchgelesen und soweit es mein Englisch zu lässt auch verstanden. Aber mein Problem besteht weiter. In dem letzten Beispiel in der PDF wird ja ein Block mit EntityJig eingefügt, dabei wird aber Basepoint ausgeschalten. Ich finde kein Beispiel in dem beides enthalten ist. Ich nehme an, daß ich Linie und Block in einer Drawjig zeichnen muß. Das probier ich jetzt mal.

Gruß, Theo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

dieses deutet (ohne dass ich es jetzt probiert hätte) schon sehr auf DragLines hin, oder?
Da wird Kreis neu positioniert und eine Linie von 0,0,0 zum aktuellen Punkt gezeigt.

Code:

---

30] Protected Overrides Function WorldDraw(ByVal draw As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean
31]    draw.Geometry.WorldLine(New Point3d(0, 0, 0), BasePt)
32]    draw.Geometry.Circle(BasePt, 1.5, Vector3d.ZAxis)

---

- alfred -

------------------
www.hollaus.at

---

Das stimmt. Und anstatt des Kreises muß ich nur noch meinen Block dran hängen. Da bin ich grad dran.

Danke, Theo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

>> Da bin ich grad dran.

Na dann wart ich mal auf das Ergebnis Deines Versuch's. 

- alfred -

------------------
www.hollaus.at

---

Hi Alfred, das ist jetzt meine JigDraw-Klasse:

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD
Public Class AU_DrawJig
    Inherits Autodesk.AutoCAD.EditorInput.DrawJig
    Dim BasePt As Point3d = New Point3d(0, 0, 0)
    Dim myMatrix As Matrix3d
    Dim myBRef As DatabaseServices.BlockReference
    Public myOpts As EditorInput.JigPromptPointOptions
    Public BlockID As ObjectId
    Public Rotation As Double
    Public Scale As Double
    Dim yvonMaus As Double
    Dim AnFrage As String
    Dim myPR As PromptPointResult
    Function StartJig() As PromptPointResult
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        myPR = ed.Drag(Me)
        Return myPR
    End Function

    Protected Overrides Function Sampler(ByVal prompts As Autodesk.AutoCAD.EditorInput.JigPrompts) As Autodesk.AutoCAD.EditorInput.SamplerStatus
        myPR = prompts.AcquirePoint(myOpts)
        If myPR.Value.IsEqualTo(BasePt) Then
            Return SamplerStatus.NoChange
        Else
            BasePt = myPR.Value
            Return SamplerStatus.OK
        End If
    End Function

    Protected Overrides Function WorldDraw(ByVal draw As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean
        draw.Geometry.WorldLine(myOpts.BasePoint, BasePt)
        myBRef = New DatabaseServices.BlockReference(BasePt, BlockID)
        myBRef.Rotation = Rotation
        myBRef.ScaleFactors = New Geometry.Scale3d(Scale, Scale, Scale)
        draw.Geometry.Draw(myBRef)
    End Function
End Class

Bestimmt nicht perfekt aber funktioniert. Aufrufen tu ich das ganze mit:

  Dim myJig As AU_DrawJig
        Using myTrans As Transaction = myDB.TransactionManager.StartTransaction
            Dim myBT As BlockTable = myDB.BlockTableId.GetObject(OpenMode.ForRead)
            Dim myBTR As BlockTableRecord = _
                myBT(Datei).GetObject(OpenMode.ForRead)
            myJig = New AU_DrawJig
            myJig.BlockID = myBTR.ObjectId
            myJig.Rotation = Win
            myJig.Scale = Faktor
            myJig.myOpts = myPDO
        End Using
        Dim SelPt As EditorInput.PromptPointResult
        SelPt = myJig.StartJig

Was denkst Du? Ist ein grundsätzlicher Fehler enthalten?
Gruß, Theo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

wenn es funktioniert, dann bist Du mal einen großen Schritt weiter. Ich kann aber jetzt nicht probieren (Zeit).

Beim Überfliegen sehe ich nur folgendes Fragezeichen dabei: bei jedem WorldDraw erzeugst Du eine neue BlockRef .... und am Ende gibt's dann kein .dispose ==> vielleicht fängt das die Funktion selbst schon ab, ich vermute aber doch, dass das Deinem Speicherverhalten nicht dienlich ist.

Das überprüfen kannst Du, wenn Du in VS das Fenster 'Ausgabe' anguckst, wenn dort mehrmals sowas vorkommt: Forgot to dispose (Wortlaut so ähnlich, nicht genau), dann hast Du Handlungsbedarf.
Ich würde beim Initialisieren der Klasseninstanz eine BlockRef erzeugen und dann diese schieben, nicht immer neu instanzieren; am Ende des JIG's dann explizit mit .dispose bereinigen.

- alfred -

------------------
www.hollaus.at

---

Hallo Alfred,

ich bin ganz gut weiter gekommen. Es funktioniert schon recht gut.
Jetzt habe ich aber doch noch ein Problemchen. Und zwar möchte ich einen zweiten Block darstellen der aber still steht, also nicht an der Maus hängt. Er müßte also nicht jedesmal neu gezeichnet werden sondern müsste nur einmal dargestellt werden. In welcher Funktion der Draw-Klasse müsste das geschehn. Im Augenblick siehe unten habe ich die zeile:
        draw.Geometry.Draw(myBRef2)
in der worlddraw-funktion stehen, und der Block wird jedesmal neu gezeichnet.
Danke Theo

Public Class DrawJigweitererPunkt
    Inherits Autodesk.AutoCAD.EditorInput.DrawJig
    Dim BasePt As Point3d = New Point3d(0, 0, 0)
    Dim myMatrix As Matrix3d
    Dim myBRef As DatabaseServices.BlockReference
    Dim myBRef2 As DatabaseServices.BlockReference
    Public myOpts As EditorInput.JigPromptPointOptions
    Public BlockID As ObjectId
    Public Rotation As Double
    Public Scale As Double
    Public Yaussermitte As Double
    Dim yvonMaus As Double
    Dim AnFrage As String
    Dim myPR As PromptPointResult
    Const Pi As Double = 3.14159265358979
    Function StartJig() As PromptPointResult
        Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
        myBRef = New DatabaseServices.BlockReference(myOpts.BasePoint, BlockID)
        myBRef2 = New DatabaseServices.BlockReference(myOpts.BasePoint, BlockID)
        myBRef.ScaleFactors = New Geometry.Scale3d(Scale, Scale, Scale)
        myBRef2.ScaleFactors = New Geometry.Scale3d(Scale, Scale, Scale)
        myPR = ed.Drag(Me)
        Return myPR
        myBRef.Dispose()
        myBRef2.Dispose()
    End Function

    Protected Overrides Function Sampler(ByVal prompts As Autodesk.AutoCAD.EditorInput.JigPrompts) As Autodesk.AutoCAD.EditorInput.SamplerStatus
        myPR = prompts.AcquirePoint(myOpts)
        If myPR.Value.IsEqualTo(BasePt) Then
            Return SamplerStatus.NoChange
        Else
            BasePt = myPR.Value
            Return SamplerStatus.OK
        End If
    End Function

    Protected Overrides Function WorldDraw(ByVal draw As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean
        draw.Geometry.WorldLine(myOpts.BasePoint, BasePt)
        Dim Führungsvektor As Geometry.Vector3d
        Dim Führungswinkel As Double
        Dim XX As Double
        Dim YY As Double
        Dim Pflag As String
        Dim Einfügepunkt As Geometry.Point3d
        Führungsvektor = myOpts.BasePoint.GetVectorTo(BasePt)
        Führungswinkel = Führungsvektor.AngleOnPlane(New Geometry.Plane)
        Führungswinkel = (Führungswinkel / Pi) * 180
        If Führungswinkel >= 45 And Führungswinkel <= 135 Then 'eioben
            If Rotation = 0 Then
                XX = Scale * Yaussermitte
                YY = Scale * 3.8
            End If
            If Rotation > 0 Then
                XX = 0
                YY = 0
            End If
        End If
        If Führungswinkel > 135 And Führungswinkel < 225 Then 'eilinks
            If Rotation = 0 Then
                XX = 2 * Scale * Yaussermitte
                YY = 0
            End If
            If Rotation > 0 Then
                XX = -3.8 * Scale
                YY = Scale * Yaussermitte
            End If
        End If
        If Führungswinkel >= 225 And Führungswinkel <= 315 Then 'eiunten
            If Rotation = 0 Then
                XX = Scale * Yaussermitte
                YY = Scale * -3.8
            End If
            If Rotation > 0 Then
                XX = 0
                YY = 2 * Scale * Yaussermitte
            End If
        End If
        If Führungswinkel > 315 Or Führungswinkel < 45 Then 'eirechts
            If Rotation = 0 Then
                XX = 0
                YY = 0
            End If
            If Rotation > 0 Then
                XX = 3.8 * Scale
                YY = Scale * Yaussermitte
            End If
        End If
        myBRef.Position = New Geometry.Point3d(BasePt.X + XX, BasePt.Y + YY, BasePt.Z)
        myBRef.Rotation = Rotation
        draw.Geometry.Draw(myBRef)
        draw.Geometry.Draw(myBRef2)

    End Function

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi,

>> Und zwar möchte ich einen zweiten Block darstellen der aber still steht, also nicht an der Maus hängt

Wieso fügst Du den nicht ganz normal vor Deinem JIG-Aufruf ein?

- alfred -

------------------
www.hollaus.at

---

Guten Morgen Alfred,

habe ich mir auch überlegt. Hat aber zwei Nachteile. Ich müsste ihn anschließend vieleicht löschen oder auch nur verschieben, je nachdem was der Anwender eingibt. Aber das größere Problem ist, daß er vieleicht benötigte Fangpunkte verdecken würde und auch selbst Fangpunkte liefern würde, was nur zu einer unübersichlichen Eingabe führen würde.
Nein es läuft eigentlich so schon ganz gut, nur daß halt bei jedem Mauszucken beide Blöcke neu aufgebaut werden, was nicht sein müßte, weil der zweite Block seine Possition ja nicht verändert.

Noch eine andere Frage habe ich. Gibt es eine Möglichkeit den zweiten Block transparent oder heller oder vielleicht auch gestrichelt darzustellen?

Danke, Theo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP