---

fasen1.JPG

Hallo zusammen!

Ich kommen aus dem Tischlerhandwerk und zeichne viel Plattenware sprich Span- u. MDF - Platten etc.
Diese werden schon mal furniert oder beschichtet und bekommen zur Kennzeichnung eine entsprechende Furnierlinie eingezeichnet, siehe Anlage.
Fase oder runde ich nun die Ecke ab, bleibt die Furnierlinie bestehen und ich muß diese nachträglich stutzen.
Kann man den Befehl fasen bzw. runden so ergänzen oder unter VBA aufbereiten, daß die Furnierlinie direkt mit gestutzt wird.

Wäre für jeden Lösungsansatz wie immer dankbar.

Gruß

Dirk

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

---

Hallo Dirk,

Als erstes: die Befehle Fasen, Abrunden und Stutzen gibt es nicht in VBA. Du musst die Objekte ändern (kürzen) und die Schräge (bei der Fase) bzw. den Radius (beim Abrunden) hinzufügen. Die Furnierlinie würde ich dann mit Intersection ermitteln und kürzen.
Ich persönlich Runde / Fase die Ecke und Stutze dann die Linie und die Schraffur in einem Arbeitsgang. Ist denke ich die einfachste Lösung.

Gruß, Carsten

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

---

Hallo Dirk,

wie Carsten bereits sagte kannst du den Runden/Fasen Befehl nicht als AutoCAD Methode ausführen.
Ich schätze jedoch das so eine Funktion trotzdem möglich ist. Wobei ich nicht beurteilen kann ob sich der Aufwand lohnt.
Ich würde es so anfangen:
- Flag setzen das Befehl aktiv
- Mit sendcommand Runden/Fasen Befehl auswählen
- Mit den Events für Neu/Ändern die gewählten Objekte merken (in einen Stapel)
- Nach dem Event CommandEnd die Extremwerte (Unten links, Oben Rechts) auslesen.
- Ein Selectionset über die Extremwerte als Kreuzenfenster um die Linien die zu stutzen zu finden
- Mit der Methode IntersecWith die Schnittpunkte berechnen
- Eine Längenberechnung Schnitt zu den Enden der Linie
- Die kürze Linie abschneiden (Koordinaten auf Schnittpunkt setzen

Das sollte gehen. Zu beachten wäre dann noch das die Elemente Linien, Polylinien, LWPolylinien, Bögen und so was sein können.
Melde dich doch mal wie es weiter geht. Hört sich auf jedenfall Interessant an.

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Carsten!
Hallo Stelli1!

Auf diese Idee bin ich durch ein anderes CAD Programm - PointLine - gekommen, daß ich mir vor kurzem mal anschauen sollte.
Einige Funktionen so wie diese fand ich ganz nützlich, gerade für den Innenausbauer.

Einiges von Deinen Ansätzen Stelli würde ich vielleicht noch hinbekommen aber mit diesen  habe ich Probleme wie ich da den Ansatz bekommen kann:

Zitat:

---

Ich würde es so anfangen:
- Flag setzen das Befehl aktiv
- Mit sendcommand Runden/Fasen Befehl auswählen
- Mit den Events für Neu/Ändern die gewählten Objekte merken (in einen Stapel)
- Nach dem Event CommandEnd die Extremwerte (Unten links, Oben Rechts) auslesen.
- Ein Selectionset über die Extremwerte als Kreuzenfenster um die Linien die zu stutzen zu finden
- Mit der Methode IntersecWith die Schnittpunkte berechnen
- Eine Längenberechnung Schnitt zu den Enden der Linie
- Die kürze Linie abschneiden (Koordinaten auf Schnittpunkt setzen
Das sollte gehen. Zu beachten wäre dann noch das die Elemente Linien, Polylinien, LWPolylinien, Bögen und so was sein können.

---

Wäre schön, wenn Ihr mir wie schon so oft, dabei helfen könntet.

Gruß

Dirk

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

---

Hallo Dirk,

Mit Events kannst du Ereignisse abfangen (z.B. Datei schließen, Befehlsbeendigung). Schau mal in der Hilfe unter Events nach.
Um mit IntersectWith Schnittpunkte berechnen zu können musst du ein Objekt nehmen und mit anderen Objekt überprüfen, ob Sie sich schneiden, daher sollen die Objekte, die geändert (durch Runden / Fasen) wurden in einem Stapel per Event aufgenommen werden.
Dadurch erhälst du für die einzelnen Elemente die Schnittpunkte, worauf du den Endpunkt des Elements ändern musst. (Endpunkt der Funierlinie = Schnittpunkt Funierlinie mit der Fase usw.)

Ich hoffe mal das das verständlich ist.

Gruß, Carsten

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

---

Hallo zusammen!

Ich dachte das mit dem fasen über sendcommand bekomme ich mal eben hin, aber geht nicht.
So weit bin ich:

Code:

---

Private Sub cmd1_Click()
Dim abstand1 As Integer
Dim abstand2 As Integer
abstand1 = tbo1.Value
abstand2 = tbo2.Value
fasen_test.Hide  
On Local Error Resume Next
ThisDrawing.SendCommand "_chamfer" & vbCr & "a" & vbCr & abstand1 & vbCr & abstand2 & vbCr
End Sub

---

""Wie schalte ich nun um, so daß ich die Linien auch anklicken kann?""
Geht doch!!

Gruß

Dirk

[Diese Nachricht wurde von Dirk.B am 13. Okt. 2006 editiert.]

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

---

Hallo Carsten!
Hallo Stelli!

Das mit den Flags und Events verstehe ich nicht.
Auch mit der Hilfe komme ich nicht wirklich klar.

Vielleicht fällt der Groschen/Cent ja noch?

Ich gib die Hoffnung mal nicht auf.

Gruß

Dirk

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

---

Hallo Dirk,

Du musst dir ein Flag setzen, damit du weisst, wenn dein Befehl (chamfer) per Event beendet wird. Wenn du kein Flag dafür setzt, wird wenn das Event ausgelöst wird (Befehl Fasen wird beendet) immer der Code des Evtns ausgeführt.

Setz das Beispiel endcommand-Event aus der Hilfe mal in ein das Modul "Thisdrawing" und und benutze einen Befehl. Sobald der Befehl beendet wird bekommst du eine Messagebox, wo dir mitgeteilt wird, welcher Befehl es war.

Gruß, Carsten

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

---

Hi!

Ich mag mich ja vielleicht blöd anstellen, aber mit dem endcommand, Event und Stapelverarbeitung komme ich nicht klar.
Könntet Ihr mir da etwas detaillierter unter die Arme greifen.

Vielen Dank.

Gruß

Dirk

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

---

Hallo Dirk,

Kopier mal folgendes in ein Modul unter Thisdrawing:

Option Explicit

Public Sub AcadDocument_EndCommand(ByVal CommandName As String)
Select Case CommandName
Case "LINE"
MsgBox "Befehl Linie wurde beendet"
'Hier Flag auswerten, ob es der Befehl der eigenen Sub war.
Case "CIRCLE"
MsgBox "Befehl Kreis wurde beendet"
End Select
End Sub

Zeichne dann mal einen Kreis oder eine Linie und beende den Befehl (Aber nicht mit ESC!).
Du bekommst dann eine Meldung, welcher Befehl beendet wurde. Hier benötigst du dein Flag, welches du vor dem SendCommand-Aufruf des Befehls stehen hats, weil sonst jedes mal, wenn dieser Befehl vom User ausgeführt wird das Event ausgelöst wird. Und das soll ja nur passieren, wenn es von deiner Sub aus gestartet wurde.

Edit: Kleiner Nachtrag:
Du benötigst das Encommand-Event, da die Befehle über Sendcommand asynchron zum VBA laufen und du sonst im VBA nicht feststellen kannst, ob der Befehl noch läuft. Das ist einer der Gründe, warum man kein Sendcommand nutzen sollte(Ausser wenn es nicht anders geht).
Was aber hier noch fehlt ist, was passiert, wenn der Nutzer die Aktion mit ESC abbricht. Da gibt es nämlich kein Event für.

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 17. Okt. 2006 editiert.]

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

---

fasen.zip

Hallo Dirk,

hab mal auf die schnelle was probiert.
Das Script geht davon aus, das es sich bei
der zu bearbeitenen Linie um eine LWPolyline handelt.
Die zu stutzende Linie ist eine normale Linie.
Das sollte als Gedankenanstoss reichen.

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo und guten morgen Stelli!

Vielen Dank.
Das muß ich mir mal auf der Zunge zergehen lassen.
Ich habe das Beispiel geladen und ausprobiert.
Das fasen funktioniert, nur die Linie wird nicht gestutzt?

Gruß

Dirk

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

---

Hallo Dirk,
unter den beschriebenen Voraussetzungen (in beigefügter DWG) bei mir schon.

Stelli

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hi Dirk,

Man kann es auch ohne sendcommand hinbekommen, das die beiden linien abgerundet werden. Allerdings gehört da ein wenig Mathematik zu.
Ich hab mich mal hingesetzt und das folgende ist dabei rausgekommen:

   

Sobald ichs fertig habe, stelle ichs wenn gewünscht natürlich hier ein.

Gruß, Carsten

[Diese Nachricht wurde von Carsten1210 am 18. Okt. 2006 editiert.]

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

---

Hallo Carsten!

Perfekt, daß ist das was ich in dem Programm Point Line gesehen habe.
Da bin ich mal gespannt, wie der Code lautet und wie Du das hinbekommen hast?

Ferner würde mich interessieren, wie Du das mit dem animierten Bildchen gemacht hast?

Gruß

Dirk

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

---

Runden_Fasen.zip

Hi Dirk,

Anbei die Makros fürs Fasen und Stutzen. Viel Spass beim auprobieren / Nutzen. 

Gruß, Carsten

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

---

User_DialogBox.jpg

Hallo Carsten!
Hallo Wilfried!

Das mit dem runden und fasen von Carsten funktioniert prima, da würde mich natürlich der Quellcode noch interessieren?

Wie baue ich denn bei dem Beispiel von Wilfried noch eine User_DialogBox zur Eingabe der Werte ein?

Gruß

Dirk

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

---

User_DialogBox.jpg

Hallo Wilfried!
Hallo Forum!

Das mit dem Fasen und stutzen der Linien direkt aus dem Editor funktioniert soweit gut.

Hier kurze Auszüge aus dem Programm von Wilfried:
Aus ThisDrawing:

Code:

---

Option Explicit

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
    'Dim objModified As Variant
    Dim objEntity As AcadEntity
    Dim Koordinaten As Variant
    Dim minRechts As Double
    Dim minHoch As Double
    Dim maxRechts As Double
    Dim maxHoch As Double
    Dim MinPunkt(0 To 2) As Double
    Dim MaxPunkt(0 To 2) As Double
    Dim SchnittPunkte As Variant
    Dim LocalCollection As Collection
   
    Dim i As Integer
    Set LocalCollection = objModified
   
    If MyStapel = True Then
        ' Zurücksetzen
        minRechts = 99999999 ' eigentlich Extremwerte der Zeichnung
        minHoch = 99999999 ' eigentlich Extremwerte der Zeichnung
        maxRechts = -99999999 ' eigentlich Extremwerte der Zeichnung
        maxHoch = -99999999 ' eigentlich Extremwerte der Zeichnung
       
        If LocalCollection.Count > 0 Then
          For Each objEntity In LocalCollection
              Debug.Print objEntity.Handle
              Select Case objEntity.ObjectName
                  Case "AcDbPolyline"
                    Koordinaten = objEntity.Coordinates
                    ' Koordinatenfeld durchlaufen (2D)
                    For i = 0 To UBound(Koordinaten) - 1 Step 2
                       
...
              End Select
          Next objEntity
          ' Selectionset bilden
          MinPunkt(0) = minRechts
          MinPunkt(1) = minHoch
          MaxPunkt(0) = maxRechts
          MaxPunkt(1) = maxHoch
         
         
          Sset.Clear
          Sset.Select acSelectionSetCrossing, MinPunkt, MaxPunkt
          For Each objEntity In Sset
                If objEntity.Handle <> objModified.Item(1).Handle Then
                    ' Schnitte berechnen
                    SchnittPunkte = objEntity.IntersectWith(objModified.Item(1), acExtendNone)
                    Debug.Print UBound(SchnittPunkte)
                    If UBound(SchnittPunkte) = 2 Then
                      'ThisDrawing.ModelSpace.AddPoint SchnittPunkte
                      ' geht so nur in dem Fall wenn
                      ' Linie und Richtung OK
                      ' Hier muss noch eine Fallunterscheidung rein
                      objEntity.EndPoint = SchnittPunkte
                      objEntity.Update
                    End If
                End If
          Next objEntity
         
        End If
    End If
   
   
    MyCommand = False
    MyStapel = False
End Sub

Private Sub AcadDocument_ObjectModified(ByVal Object As Object)
  Dim objEntity As AcadEntity
  Debug.Print Object.ObjectName
 
  If MyCommand = True And MyStapel = False Then
        If Object.ObjectName = "AcDbPolyline" Then
            Set objEntity = Object
            objModified.Add objEntity
            MyStapel = True
        End If
  End If
End Sub

---

Aus Modul:

Code:

---

Option Explicit

' Flag
Public MyCommand As Boolean
Public MyStapel As Boolean
Public objModified As Collection
Public ObjNew As Collection
Public Sset As AcadSelectionSet

Sub MeinFasen()
    ' Selectionset
    On Error Resume Next
    Set Sset = ThisDrawing.SelectionSets("Mysel")
    If Err Then
      Set Sset = ThisDrawing.SelectionSets.Add("Mysel")
    End If
    On Error GoTo 0

    ' Collection zurücksetzen
    Set objModified = New Collection
    MyCommand = True
    MyStapel = False
    ThisDrawing.SendCommand "_chamfer" & vbCr & "a" & vbCr & 5 & vbCr & 5 & vbCr

End Sub

---

Wie kann man dieses denn nun in eine UserForm einbinden, so daß
man die Fasenabstände eingeben kann.

Ich habe mal folgendes probiert, was aber leider nicht funktioniert.
Das fasen ja, aber nicht das automtische stutzen.

Code:

---

Private Sub cmdOK_Click()

Dim Object As Object
Dim ObjEntity As AcadEntity
Dim ObjAll As AcadSelectionSet
Dim Sset As AcadSelectionSet
Dim Koord As Variant

Dim minRechts As Double
Dim minHoch As Double
Dim maxRechts As Double
Dim maxHoch As Double
Dim minPkt(2) As Double
Dim maxPkt(2) As Double
Dim SchnittPkt As Variant
Dim i As Integer

minRechts = 99999999
minHoch = 99999999
maxRechts = -99999999
maxHoch = -99999999

Me.Hide
On Error Resume Next
If TypeName(ThisDrawing.SelectionSets("AllObjekts")) = "Nothing" Then
    ThisDrawing.SelectionSets.Add "AllObjekts"
End If
Set ObjAll = ThisDrawing.SelectionSets("AllObjekts")

ThisDrawing.SendCommand "_chamfer" & vbCr & "a" & vbCr & TextBox1.Value & vbCr & TextBox2.Value & vbCr

ObjAll.Clear
ObjAll.Select acSelectionSetAll

For Each Object In ThisDrawing.SelectionSets("AllObjekts")
        Select Case Object.ObjectName
            Case "AcDbPolyline"
                Koord = Object.Coordinates
                    For i = 0 To UBound(Koord) - 1 Step 2
                        If Koord(i) < minRechts Then
                            minRechts = Koord(i)
                        End If
                        If Koord(i) > maxRechts Then
                            maxRechts = Koord(i)
                        End If

                        If Koord(i + 1) < minHoch Then
                            minHoch = Koord(i + 1)
                        End If
                        If Koord(i + 1) > maxHoch Then
                            maxHoch = Koord(i + 1)
                        End If
                    Next i
              End Select
    Next Object

minPkt(0) = minRechts
minPkt(1) = minHoch
maxPkt(0) = maxRechts
maxPkt(1) = maxHoch

Sset.Clear
Sset.Select acSelectionSetCrossing, minPkt, maxPkt

For Each ObjEntity In Sset
    If ObjEntity.Handle <> ObjAll.Item(1).Handle Then
        'Schnitte berechnen
        SchnittPkt = ObjEntity.IntersectWith(ObjAll.Item(1), acExtendNone)
        If UBound(SchnittPkt) = 2 Then
            ObjEntity.EndPoint = SchnittPkt
            ObjEntity.Update
        End If
    End If
Next ObjEntity

End Sub

---

Die Dinge von Carsten funktionieren auch prima, nur da werden die Polylinien gesprengt.
Mich interessiert der Quelcode um das ganze aus einer UserForm umzusetzen, da ich dieses als Grundlage für weitere kleinere Programme benötige.

Vielen Dank im voraus für Eure Hilfe.

Gruß

Dirk

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

---

Hi Dirk,

Was für ein Fehler tritt bei dir denn auf?! Oder besser gesagt, was funktioniert denn genau nicht?!
Ich könnte das Makro oben noch so umschreiben, das die Polylinien erhalten bleiben, aber im Moment fehlt mir die Zeit dazu.

Gruß, Carsten

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

---

Hallo Carsten!

Wie gehts?

Das mit dem fasen über

Code:

---

ThisDrawing.SendCommand "_chamfer" & vbCr & "a" & vbCr & _
TextBox1.Value & vbCr & TextBox2.Value & vbCr

---

mit Werten aus der Dialogbox funktioniert.

Was nicht funktioniert ist, daß das zu fasende Objekt erkannt
und die Furnierlinie gestutzt wird.

In dem Programm von Wilfried funktioniert das ganze, allerdings nur
direkt aus dem Editor.
Wenn ich das über einen Werzeugbutton probiere (c^c^ -vbarun ...)
geht das nicht?

Da ja bei dem SendCommand das Objekt eh angeklickt wird, könnte man
dieses nicht zur Selection nutzen und die GetBoundingBox Funktion anwenden?

Mittels

Code:

---

...
Dim Sset As AcadSelectionSet
...
'--zuerst fasen
ThisDrawing.SendCommand "_chamfer" & vbCr & "a" & vbCr & _
TextBox1.Value & vbCr & TextBox2.Value & vbCr
...
'--zuletzt erzeugtes / bearbeitets Objekt
sset.Select acSelectionSetLast
...

---

hatte ich versucht, ob erkannt wird, daß das gefaste Objekt über
acSelectionSetLast gefiltert werden kann.
Das funktionierte aber leider nicht.

Hast Du oder jemand anders noch ne Idee wie das laufen könnte?

Vielen Dank im voraus für weitere Hilfe.

Gruß

Dirk

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

---

Fasen01.jpg Fasen02.jpg

Hallo zusammen!

Ich muß das Forum ja mal wieder loben, denn wenn man sich mal Zeit nimmt und sucht, liest und testet kommt man schon zu einem positiven Ergebnis.

Nun habe ich das Programm über eine Dialogbox ans laufen bekommen
und es sieht wie folgt aus:

Grundsätzlich habe ich mich an den Quellcode von Wilfried angehangen, nur erfolgt die Auswahl des zu fasenden Objekts über

Code:

---

...
If MyCommand = "CHAMFER" Then
    If Object.ObjectName = "AcDbPolyline" Or "AcDbLWPolyline" Then
        Set NewEntity = Object
        NewObjModi.Add NewEntity
        MyStatusModi = True
    End If
End If
...

---

Code:

---

Private Sub AcadDocument_BeginCommand(ByVal CommandName As String)
    MyCommand = CommandName
End Sub

---

Über den folgenden Code wird ja der benötigte Schnittpunkt ermittelt und die Linie über verschiebung des Endpnktes geändert.

Code:

---

Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
...
    Dim i As Integer
    Set LocalCollection = NewObjModi

    If MyStatusModi = True Then
        ' Zurücksetzen
        minRechts = 99999999 ' eigentlich Extremwerte der Zeichnung
        minHoch = 99999999 ' eigentlich Extremwerte der Zeichnung
        maxRechts = -99999999 ' eigentlich Extremwerte der Zeichnung
        maxHoch = -99999999 ' eigentlich Extremwerte der Zeichnung

        If LocalCollection.Count > 0 Then
          For Each objEntity In LocalCollection
              Debug.Print objEntity.Handle
              Select Case objEntity.ObjectName
                  Case "AcDbPolyline"
                    Koordinaten = objEntity.Coordinates
                    ' Koordinatenfeld durchlaufen (2D)
                    For i = 0 To UBound(Koordinaten) - 1 Step 2
                        If Koordinaten(i) < minRechts Then
                            minRechts = Koordinaten(i)
                        End If
                        If Koordinaten(i) > maxRechts Then
                            maxRechts = Koordinaten(i)
                        End If

                        If Koordinaten(i + 1) < minHoch Then
                            minHoch = Koordinaten(i + 1)
                        End If
                        If Koordinaten(i + 1) > maxHoch Then
                            maxHoch = Koordinaten(i + 1)
                        End If
                    Next i
              End Select
          Next objEntity
          ' Selectionset bilden
          MinPunkt(0) = minRechts
          MinPunkt(1) = minHoch
          MaxPunkt(0) = maxRechts
          MaxPunkt(1) = maxHoch

          Sset.Clear
          Sset.Select acSelectionSetCrossing, MinPunkt, MaxPunkt
          For Each objEntity In Sset
                If objEntity.Handle <> NewObjModi.Item(1).Handle Then
                    ' Schnitte berechnen
                    SchnittPunkte = objEntity.IntersectWith(NewObjModi.Item(1), acExtendNone)
                    'Debug.Print UBound(SchnittPunkte)
                    If UBound(SchnittPunkte) = 2 Then
                      'ThisDrawing.ModelSpace.AddPoint SchnittPunkte
                      ' geht so nur in dem Fall wenn
                      ' Linie und Richtung OK
                      ' Hier muss noch eine Fallunterscheidung rein
                      objEntity.EndPoint = SchnittPunkte
                      objEntity.Update
                    End If
                End If
          Next objEntity

        End If
    End If

    MyCommand = False
    MyStatusModi = False
End Sub

---

Das Ergebnis wäre dann das Bildchen 01.

Wenn ich nun die Fasenabstände ändern möchte - siehe Bildchen 02 - sollte sich die Linie auch erneut anpassen, doch das funktioniert nicht.
Hat dafür jemand eine Idee??

Gruß

Dirk

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

---

Hallo Dirk,

schön das es geklappt hat 

Wenn ich miich recht erinnere bestimmst du den Schnittpunkt mit der Methode "intersecwith". Wenn es keinen Schnittpunkt gibt tritt das Problem auf.

Du kannst aber als Parameter mitgeben das das Objekt für die Berechnung gedehnt wird.
Gleiches kannst du ja auch beim Stutzen machen.

Wilfried Stelberg

------------------
Warum lisp'eln wenn's auch anders geht.
www.ib-stelberg.de

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

---

Hallo Wilfried!

Vielen Dank noch mal für Deine Hilfe.

Zitat:

---

Du kannst aber als Parameter mitgeben das das Objekt für die Berechnung gedehnt wird.
Gleiches kannst du ja auch beim Stutzen machen.

---

Das Objekt ansich hat doch keine Eigenschaft die das dehnen bzw.
stutzen ünterstützt, oder?
Hättest Du bzgl. der Parameter einen Denkanstoß für mich?

Könnte man nicht über den Objekt.Startpunkt und Objekt.Endpunkt
ein AcadRay erzeugen der den Schnittpunkt ermittelt?

Gruß

Dirk

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

---

Hi Dirk,

Aus der Hilfe:

RetVal = object.IntersectWith(IntersectObject, ExtendOption)

Object

All Drawing Objects (Except Pviewport and PolygonMesh)
The object or objects this method applies to.

IntersectObject

Object, input-only;
The object can be one of All Drawing Objects.

ExtendOption

AcExtendOption enum; input-only
This option specifies if none, one or both, of the objects are to be extended in order to attempt an intersection.

acExtendNone
Does not extend either object.

acExtendThisEntity
Extends the base object.

acExtendOtherEntity
Extends the object passed as an argument.

acExtendBoth
Extends both objects.

Du nutzt doch die Intersectwith-Methode zum stuzten. Damit kannst du auch dehnen.
Wie ist denn eigentlich der Ablauf deines Makros?!
Muss ich bei jedem Aufruf des Runden- bzw. Fasenbefehls das Dialogfeld wegklicken?!

Gruß, Carsten

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

---

Bild1.jpg Bild2.jpg Bild3.jpg

Hallo zusammen!

Soweit funktionierts nun.
1. Fasen mit Abstand 5/5 (Bild1)
2. Fasen mit Abstand 2/2 (Bild3)

Da aber die Points der Linie auch mal verdreht sein könnten, benötige ich noch die Möglichkeit den Line.EndPoint und Line.StartPoint zu tauschen.

Code:

---

        Sset.Clear
        Sset.Select acSelectionSetCrossing, MinPunkt, MaxPunkt
        For Each objEntity In Sset
        If objEntity.ObjectName = "AcDbLine" And NewObjModi.Item(1).ObjectName = "AcDbPolyline" _
        Or NewObjModi.Item(1).ObjectName = "AcDbLWPolyline" Then
            Set FLine = objEntity
            Set Pline = NewObjModi.Item(1)

'##--Hier müßte noch abgefragt werden bzw. der Linien Endpunkt und Startpunkt
'##--getauscht werden. Hat da einer ne Idee wie das noch gehen kann?
'            SchnittPkt = FLine.IntersectWith(Pline, acExtendNone)
'            Mass1 = MeinDistance(SchnittPkt, FLine.EndPoint)
'            Mass2 = MeinDistance(SchnittPkt, FLine.StartPoint)
'            If Mass1 > Mass2 Then
'                FLine.EndPoint(0) = FLine.StartPoint(0)
'                FLine.EndPoint(1) = FLine.StartPoint(1)
'                FLine.StartPoint(0) = FLine.EndPoint(0)
'                FLine.StartPoint(1) = FLine.EndPoint(1)
'            End If
           
            RayPkt1(0) = FLine.StartPoint(0)
            RayPkt1(1) = FLine.StartPoint(1)
            RayPkt2(0) = FLine.EndPoint(0)
            RayPkt2(1) = FLine.EndPoint(1)
            Set RayObj = ThisDrawing.ModelSpace.AddRay(RayPkt1, RayPkt2)
            SchnittPunkte = RayObj.IntersectWith(Pline, acExtendNone)
            If UBound(SchnittPunkte) = 2 Then
                FLine.EndPoint = SchnittPunkte
                FLine.Update
                RayObj.Delete
            End If
        End If
        Next objEntity
    End If
End If
MyCommand = False
MyStatusModi = False
End Sub

---

Gruß

Dirk

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

---

Hallo Dirk,

Berechne doch den Abstand vom Schnittpunkt bis zum Start- bzw. Endpunkt.

Dann kannst du doch Entscheiden, ob die Linie nun gedreht werden muss, oder nicht.
Wie ist denn nun der genaue Ablauf des Befehls, den eure Mitarbeiter ausführen müssen?!

Gruß, Carsten

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