Hallo Ralf,
Auf die Idee kam ich auch schon und habe mir das mal angeschaut. Allerdings funktioniert das auf meiner SW2005 einfach nicht.
Hier mein Makro-Text:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Sub main()
Set swApp = Application.SldWorks
X = InputBox("Länge", "Bemassung")
Y = InputBox("Breite", "Bemassung")
Z = InputBox("Dicke", "Bemassung")
Set Part = swApp.ActiveDoc
swApp.SetUserPreferenceToggle swInputDimValOnCreate, False
boolstatus = Part.Extension.SelectByID2("Oben", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.InsertSketch2 True
Part.ClearSelection2 True
Part.SketchRectangle -X / 2000, Y / 2000, 0, X / 2000, -Y / 2000, 0, 1
Part.SetPickMode
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", -0.05440947368421, 0, -0.001470526315789, False, 0, Nothing, 0)
Part.SelectMidpoint
boolstatus = Part.Extension.SelectByID2("Punkt1@Ursprung", "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
Part.SketchAddConstraints "sgHORIZPOINTS"
boolstatus = Part.Extension.SelectByID2("Line3", "SKETCHSEGMENT", 0.005882105263158, 0, 0.02709969924812, False, 0, Nothing, 0)
Part.SelectMidpoint
boolstatus = Part.Extension.SelectByID2("Punkt1@Ursprung", "EXTSKETCHPOINT", 0, 0, 0, True, 0, Nothing, 0)
Part.SketchAddConstraints "sgVERTPOINTS"
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", -0.0537792481203, 0, -0.01302466165414, False, 0, Nothing, 0)
Set Annotation = Part.AddDimension2(-0.078148, 0, -0.00966346)
Part.ClearSelection2 True
Part.Parameter("D1@Skizze1").SystemValue = Y / 1000
boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", -0.0342422556391, 0, -0.02499894736842, False, 0, Nothing, 0)
Set Annotation = Part.AddDimension2(-0.0331919, 0, -0.039074)
Part.Parameter("D2@Skizze1").SystemValue = X / 1000
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("D1@Skizze1@Teil9.SLDPRT", "DIMENSION", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
Part.ShowNamedView2 "*Trimetrisch", 8
Part.ClearSelection2 True
Part.SelectByID "D3@Skizze1@Teil19.SLDPRT", "DIMENSION", 0, 0, 0
Part.FeatureExtrusion3 1, 0, 0, 0, 0, Z / 1000, 0.01, 0, 0, 0, 0, 0.01745329251994, 0.01745329251994, 0, 0, 0, 0, 1
boolstatus = Part.SetUserPreferenceToggle(6, False)
swApp.SetUserPreferenceToggle swInputDimValOnCreate, True
End Sub
Siehst du etwas was falsch ist?
Das Makro funktioniert soweit, aber es muss halt einfach 2x das Mass bestätigt werden. Und genau dies möchte ich ausschalten. Sorry wenn es ein DAU-Fehler ist, aber ich arbeite eigentlich sonst nicht wirklich mit Makros.
Danke
------------------
Bis demnächst!
Hans Meiser
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP