| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Ring (donut) in VBA erstellen (730 mal gelesen)
|
hjschub Mitglied Ingenieur
Beiträge: 9 Registriert: 01.04.2006 Autocad 2004
|
erstellt am: 03. Apr. 2006 17:10 <-- editieren / zitieren --> Unities abgeben:
Hallo Acad-Freunde, kann mir jemand einen VBA-Code geben, mit dem ich einen Ring erstellen kann ? Nach 3 Stunden suchen und probieren habe ich erst einmal aufgegeben. Besten Dank im Voraus. Gruß hjschub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
startrek Mitglied Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 03. Apr. 2006 17:19 <-- editieren / zitieren --> Unities abgeben: Nur für hjschub
3 Stunden - wo hast denn du gesucht? ;-) Ich hab nen Torus in einer leeren dwg erstellt, in vba modelspace.item(0) den Objekttyp abgefragt, dann F1 auf Acad3DSolid > da wird auch die Methode AddTorus() erklärt:
Code:
Sub Example_AddTorus() ' This example creates a torus in model space. Dim torusObj As Acad3DSolid Dim centerPoint(0 To 2) As Double Dim torusRadius As Double Dim tubeRadius As Double ' Define the torus centerPoint(0) = 5: centerPoint(1) = 5: centerPoint(2) = 0 torusRadius = 15 tubeRadius = 5 ' Create the torus Set torusObj = ThisDrawing.ModelSpace.AddTorus(centerPoint, torusRadius, tubeRadius) ' Change the viewing direction of the viewport Dim NewDirection(0 To 2) As Double NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1 ThisDrawing.ActiveViewport.direction = NewDirection ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport ZoomAllEnd Sub
In der Acad/VBA-Hilfe findet man Acad3DSolid relativ fix, aber nicht in der Acad-Hilfe;-)HTH Nancy [Diese Nachricht wurde von startrek am 04. Apr. 2006 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
hjschub Mitglied Ingenieur
Beiträge: 9 Registriert: 01.04.2006 Autocad 2004
|
erstellt am: 04. Apr. 2006 15:54 <-- editieren / zitieren --> Unities abgeben:
Hallo Nancy (startrek) besten Dank für den interessanten Code. Damit werde ich sicher weiterkommen. Aber erst zum Wochenende. Die Kritik an meiner Suchzeit nehme ich gern hin. Es ist ja eine konstruktive Kritik. Gruß hjschub Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
cadffm Moderator 良い精神
Beiträge: 21533 Registriert: 03.06.2002 System: F1 und Google
|
erstellt am: 04. Apr. 2006 16:07 <-- editieren / zitieren --> Unities abgeben: Nur für hjschub
|
CADmium Moderator Maschinenbaukonstrukteur
Beiträge: 13508 Registriert: 30.11.2003 Hinweis: Meine Mitarbeit auf CAD.DE ist fakultativ, unentgeltlich und beruht nur auf einem ausgeprägtem Helfersyndrom.
|
erstellt am: 04. Apr. 2006 16:22 <-- editieren / zitieren --> Unities abgeben: Nur für hjschub
.. jo .. _donut = ring wird bei mir auch ne Polylinie entsprechender globaler Breite mit 2 Stützpunkten wo Bulge = 1 dranhängt, aber naja ..@Seb:<top> ------------------ - Thomas - "Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben." Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
startrek Mitglied Architekt
Beiträge: 1361 Registriert: 13.02.2003 .
|
erstellt am: 04. Apr. 2006 17:28 <-- editieren / zitieren --> Unities abgeben: Nur für hjschub
Na toll ... Okay, ich als Bäckermädel hab als allerstes an Spritzringe und Donuts gedacht, aber nicht an den Befehl als solches, Seb, soviel zu meiner Phantasie ... ;-) Gut gut, aber nur fix zusammengeschossen:
Code:
Sub Unterlegscheibe() Dim plineObj As AcadLWPolyline Dim p1, p2#, Breite# Dim points(0 To 3) As Double On Error GoTo hell With ThisDrawing p1 = .Utility.GetPoint(, "Mittelpunkt:") p2 = .Utility.GetReal("Radius: ") Breite = .Utility.GetReal("globale Breite: ") points(0) = p1(0) - p2: points(1) = p1(1) points(2) = p1(0) + p2: points(3) = p1(1) Set plineObj = .ModelSpace.AddLightWeightPolyline(points) End With With plineObj .SetBulge 0, 1 .Closed = 1 .SetBulge 1, 1 .ConstantWidth = Breite .Update End With ZoomAll hell: End Sub
lg Nancy
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
hjschub Mitglied Ingenieur
Beiträge: 9 Registriert: 01.04.2006 Autocad 2004
|
erstellt am: 05. Apr. 2006 18:43 <-- editieren / zitieren --> Unities abgeben:
|
hjschub Mitglied Ingenieur
Beiträge: 9 Registriert: 01.04.2006 Autocad 2004
|
erstellt am: 05. Apr. 2006 18:46 <-- editieren / zitieren --> Unities abgeben:
|