| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Linie zeichnen (2128 mal gelesen)
|
Crash_Master Mitglied Fachinformatiker
Beiträge: 32 Registriert: 06.10.2003
|
erstellt am: 06. Okt. 2003 12:54 <-- editieren / zitieren --> Unities abgeben:
Hi Leute, Für meine Abschlußarbeit muß ich einen Konverter schreiben der aus Geometriedaten ein VBA-Inventor Script zaubert. Das denke ich ist nicht das Problem. Allerdings versuche ich heute schon den ganzen Tag per VBA eine einfache Linie zu zeichnen von der ich jeweils Startpunkt (x,y,z) weiß und den Endpunkt (x,y,z). Hat da einer von euch mal ein Codeschnipsel für mich der sowas macht. In der Hilfe finde ich leider auch nur die ClientGraphics, und da bin ich mir nicht sicher ob das wirklich eine Linie ist, da ich sie zwar sehen, aber nicht anwählen kann nach dem Zeichnen. Ciao Crash
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
daywa1k3r Moderator Softwareentwickler
Beiträge: 3497 Registriert: 01.08.2002 Alienware m17x, Win7, Inventor2012
|
erstellt am: 06. Okt. 2003 13:29 <-- editieren / zitieren --> Unities abgeben: Nur für Crash_Master
Zitat:
Allerdings versuche ich heute schon den ganzen Tag per VBA eine einfache Linie zu zeichnen...
Zitat:
In der Hilfe finde ich leider auch nur die ClientGraphics...
Selbst was probiert ? Na dann, das muss belohnt werden! Hier dein Code: Code:
Public Sub test_line() Dim oDoc As PartDocument Set oDoc = ThisApplication.ActiveDocument Dim oCompDef As PartComponentDefinition Set oCompDef = oDoc.ComponentDefinition Dim oTG As TransientGeometry Set oTG = ThisApplication.TransientGeometry Dim oSketch3d As Sketch3D Set oSketch3d = oCompDef.Sketches3D.Add Dim oPoint1, oPoint2 As WorkPoint Set oPoint1 = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(1, 1, 1)) Set oPoint2 = oCompDef.WorkPoints.AddFixed(oTG.CreatePoint(2, 2, 2)) Dim oLine3d As SketchLine3D Set oLine3d = oSketch3d.SketchLines3D.AddByTwoPoints(oPoint1, oPoint2) End Sub
------------------ Grüße daywa1k3r Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Crash_Master Mitglied Fachinformatiker
Beiträge: 32 Registriert: 06.10.2003
|
erstellt am: 06. Okt. 2003 13:46 <-- editieren / zitieren --> Unities abgeben:
|
Crash_Master Mitglied Fachinformatiker
Beiträge: 32 Registriert: 06.10.2003
|
erstellt am: 06. Okt. 2003 13:49 <-- editieren / zitieren --> Unities abgeben:
Halt, hab mich geirrt. Die Linie die ich im 2D-Modus zeichne, ist aber irgendwie eine andere, oder?? Kann ich nicht den ganz normalen Skizzenbefehl Linie aus dem 2D Werkzeugkasten irgendwie über VBA benutzen?? Ciao Crash Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Crash_Master Mitglied Fachinformatiker
Beiträge: 32 Registriert: 06.10.2003
|
erstellt am: 06. Okt. 2003 13:59 <-- editieren / zitieren --> Unities abgeben:
Zitat: Original erstellt von Crash_Master: Halt, hab mich geirrt. Die Linie die ich im 2D-Modus zeichne, ist aber irgendwie eine andere, oder??Kann ich nicht den ganz normalen Skizzenbefehl Linie aus dem 2D Werkzeugkasten irgendwie über VBA benutzen?? Ciao Crash
Hier noch schnell mein Code den ich aus der Hilfe habe, der aber leider nicht so funktiniert wie ich mir das vorstelle. Code:
Public Sub DrawCustomLines() Dim oDoc As Document Set oDoc = ThisApplication.ActiveDocument ' Set a reference to component definition of the active document. ' This assumes that a part or assembly document is active. Dim oCompDef As ComponentDefinition Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition ' Check to see if the test graphics data object already exists. ' If it does clean up by removing all associated of the client graphics ' from the document. If it doesn't create it. On Error Resume Next Dim oGraphicsData As GraphicsDataSets Set oGraphicsData = oDoc.GraphicsDataSetsCollection.Item("SampleGraphicsID") If Err.Number = 0 Then On Error GoTo 0 ' An existing client graphics object was successfully obtained so clean up. oGraphicsData.Delete oCompDef.ClientGraphicsCollection.Item("SampleGraphicsID").Delete ' update the display to see the results. ThisApplication.ActiveView.Update Else Err.Clear On Error GoTo 0 ' Set a reference to the transient geometry object for user later. Dim oTransGeom As TransientGeometry Set oTransGeom = ThisApplication.TransientGeometry ' Create a graphics data set object. This object contains all of the ' information used to define the graphics. Dim oDataSets As GraphicsDataSets Set oDataSets = oDoc.GraphicsDataSetsCollection.Add("SampleGraphicsID") ' Create a coordinate set. Dim oCoordSet As GraphicsCoordinateSet Set oCoordSet = oDataSets.CreateCoordinateSet(1) Dim oPointCoords(1 To 6) As Double oPointCoords(1) = 0 oPointCoords(2) = 0 oPointCoords(3) = 0 oPointCoords(4) = 10 oPointCoords(5) = 10 oPointCoords(6) = 10 ' Assign the points into the coordinate set. Call oCoordSet.PutCoordinates(oPointCoords) ' Create the ClientGraphics object. Dim oClientGraphics As ClientGraphics Set oClientGraphics = oCompDef.ClientGraphicsCollection.Add("SampleGraphicsID") ' Create a new graphics node within the client graphics objects. Dim oLineNode As GraphicsNode Set oLineNode = oClientGraphics.AddNode(1) ' Create a LineGraphics object within the node. Dim oLineSet As LineGraphics Set oLineSet = oLineNode.AddLineGraphics ' Assign the coordinate set to the line graphics. oLineSet.CoordinateSet = oCoordSet ' Assign a color to the node using an existing rendering style. This ' assumes the rendering style "Purple" exists. oLineNode.RenderStyle = oDoc.RenderStyles.Item("Purple") ' Update the view to see the resulting spiral. ThisApplication.ActiveView.Update
Es kann sein das du "Purple" gegen etwas anderes ersetzen mußt. Hier kommt dann zwar eine sichtbare Linie raus, diese kann ich aber nicht anklicken um beispielsweise mit der Hand vom Endpunkt aus weiter zu zeichnen. Ciao Sascha Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
daywa1k3r Moderator Softwareentwickler
Beiträge: 3497 Registriert: 01.08.2002 Alienware m17x, Win7, Inventor2012
|
erstellt am: 06. Okt. 2003 14:13 <-- editieren / zitieren --> Unities abgeben: Nur für Crash_Master
Hi, vielleicht schafft das Beispiel (Hilfe) DrawSketchLine mehr Klarheit: Code:
Public Sub DrawSketchLine() ' Check to make sure a sketch is open. If Not TypeOf ThisApplication.ActiveEditObject Is PlanarSketch Then MsgBox "A sketch must be active." Exit Sub End If ' Set a reference to the active sketch. Dim oSketch As PlanarSketch Set oSketch = ThisApplication.ActiveEditObject ' Set a reference to the transient geometry collection. Dim oTransGeom As TransientGeometry Set oTransGeom = ThisApplication.TransientGeometry ' Create a new transaction to wrap the construction of the three lines ' into a single undo. Dim oTrans As Transaction Set oTrans = ThisApplication.TransactionManager.StartTransaction( _ ThisApplication.ActiveDocument, _ "Create Triangle Sample") ' Create the first line of the triangle. This uses two transient points as ' input to definethe coordinates of the ends of the line. Since a transient ' point is input a sketch point is automatically created at that location and ' the line is attached to it. Dim oLines(1 To 3) As SketchLine Set oLines(1) = oSketch.SketchLines.AddByTwoPoints(oTransGeom.CreatePoint2d(0, 0), _ oTransGeom.CreatePoint2d(4, 0)) ' Create a sketch line that is connected to the sketch point the previous lines ' end point is connected to. This will automatically create the constraint to ' tie the new line to the sketch point the previous line is also connected to. ' This will result in the the two lines being connected since they're both tied ' to the same sketch point. Set oLines(2) = oSketch.SketchLines.AddByTwoPoints(oLines(1).EndSketchPoint, _ oTransGeom.CreatePoint2d(2, 3)) ' Create a third line and connect it to the start point of the first line and the ' end point of the second line. This will result in a connected triangle. Set oLines(3) = oSketch.SketchLines.AddByTwoPoints(oLines(2).EndSketchPoint, _ oLines(1).StartSketchPoint) ' End the transaction for the triangle. oTrans.End ' Create a rectangle whose lines are parallel to the sketch planes x and y axes ' by using the SketchLines.AddAsTwoPointRectangle method. The top point of the ' triangle will be used as input for one of the points so the rectangle will be ' tied to that point. Dim oRectangleLines As SketchEntitiesEnumerator Set oRectangleLines = oSketch.SketchLines.AddAsTwoPointRectangle( _ oLines(3).StartSketchPoint, _ oTransGeom.CreatePoint2d(5, 5)) ' Create a rotated rectangle by using the SketchLines.AddAsTwoRectangle method. ' One of the corners of this rectangle will be tied to the corner of the previous ' rectangle. Set oRectangleLines = oSketch.SketchLines.AddAsThreePointRectangle( _ oRectangleLines(2).EndSketchPoint, _ oTransGeom.CreatePoint2d(7, 3), _ oTransGeom.CreatePoint2d(8, 8)) End Sub
------------------ Grüße daywa1k3r Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Crash_Master Mitglied Fachinformatiker
Beiträge: 32 Registriert: 06.10.2003
|
erstellt am: 06. Okt. 2003 14:28 <-- editieren / zitieren --> Unities abgeben:
Ich glaub das ist schon eher das was ich mir vorstelle. Mal sehen ob ich damit mehr anfangen kann. Erst mal muß ich jetzt mal durch den Code durchblicken. Aber trotzdem danke für deine schnelle Hilfe... Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
daywa1k3r Moderator Softwareentwickler
Beiträge: 3497 Registriert: 01.08.2002 Alienware m17x, Win7, Inventor2012
|
erstellt am: 06. Okt. 2003 14:33 <-- editieren / zitieren --> Unities abgeben: Nur für Crash_Master
Und "Purple" gibt es in german nicht, daher sollte "Purpur" funktionieren. PS: Solltest du mit dem Beispiel nicht klar kommen (es macht doch mehr als eine Linie zu zeichnen), ruhig sagen, dann werde ich es vereinfachen. ------------------ Grüße daywa1k3r Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Crash_Master Mitglied Fachinformatiker
Beiträge: 32 Registriert: 06.10.2003
|
erstellt am: 06. Okt. 2003 14:43 <-- editieren / zitieren --> Unities abgeben:
Soweit blicke ich hier schon durch. Damit kann ich glaub ich schon was anfangen. Wofür kann ich dieses Code-Schnipsel brauchen. Laut Doku soll es mir die Möglichkeit geben Dinge rückgängig zu machen. Das kann ich doch aber über Bearbeiten => Rückgängig auch machen. Oder sehe ich das falsch?? Code:
' Create a new transaction to wrap the construction of the three lines ' into a single undo. Dim oTrans As Transaction Set oTrans = ThisApplication.TransactionManager.StartTransaction( _ ThisApplication.ActiveDocument, _ "Create Triangle Sample") ... ... ... oTrans.End
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
daywa1k3r Moderator Softwareentwickler
Beiträge: 3497 Registriert: 01.08.2002 Alienware m17x, Win7, Inventor2012
|
erstellt am: 06. Okt. 2003 14:56 <-- editieren / zitieren --> Unities abgeben: Nur für Crash_Master
Also, soviel ich verstanden habe, hat es schon mit undo redo zu tun. Das Dreieck wird mit Linie-Linie-Linie gezeichnet. Mit dem Befehl: Set oTrans = ThisApplication.TransactionManager.StartTransaction( _ ThisApplication.ActiveDocument, _ "Create Triangle Sample") schaffst du mit undo das ganze Dreieck zu löschen / wiederherstellen. Ohne "oTrans" würdest du mit undo nur eine Linie löschen. Oder so ... ------------------ Grüße daywa1k3r Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Crash_Master Mitglied Fachinformatiker
Beiträge: 32 Registriert: 06.10.2003
|
erstellt am: 06. Okt. 2003 16:19 <-- editieren / zitieren --> Unities abgeben:
Noch eine Frage... Gibt es da jetzt auch irgendwas ähnliches für Kreise und Rechtecke? Halt die Geometrischen Figuren?? Das mit den Linien scheint jetzt eigentlich so weit zu klappen wie ich mir das vorstelle... Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Charly Setter Ehrenmitglied V.I.P. h.c.
Beiträge: 11977 Registriert: 28.05.2002 Trau keiner Diva unter SP2....
|
erstellt am: 06. Okt. 2003 16:50 <-- editieren / zitieren --> Unities abgeben: Nur für Crash_Master
|
daywa1k3r Moderator Softwareentwickler
Beiträge: 3497 Registriert: 01.08.2002 Alienware m17x, Win7, Inventor2012
|
erstellt am: 06. Okt. 2003 16:53 <-- editieren / zitieren --> Unities abgeben: Nur für Crash_Master
|