Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks
  Ertes Macro HILFE!!

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für SOLIDWORKS
  
Wie Produktkonfiguratoren Ihren Vertriebsprozess nachhaltig unterstützen
Autor Thema:  Ertes Macro HILFE!! (649 mal gelesen)
ammarasaad3133
Mitglied


Sehen Sie sich das Profil von ammarasaad3133 an!   Senden Sie eine Private Message an ammarasaad3133  Schreiben Sie einen Gästebucheintrag für ammarasaad3133

Beiträge: 3
Registriert: 05.05.2021

erstellt am: 05. Mai. 2021 20:02    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Guten Morgen,

Solidworks Macros sind echt eine gute Sache, aber ich hab mir als erstes Projekt ein sehr schweren Projekt aufgenommen.

Anbei ist ein Programm, der Aufgabenstellung ist so

1- Von Baugruppe aus jeden Bauteil öffnen. ( auch in Unterbaugruppen)

2- in jedem Bauteil ein neuen Koordinaten System erstellen, der bündig mit den Faces ist, ein 3d Skizze erstellen, die in jede Mid Punkt von jeder Edge ein Punkt zeichnet.

3- Danach kommt der excel Datei erstellung

und das passiert zu jedem Bauteil

der Excel Import habe ich in einem Forum gefunden, und der andere von Codesstack.com sollte jede Edge mit Punkten Teilen... das habe ich als Alternative für die Midpunkte genommen, jedoch leider es erstellt keine Punkte ):

mit dem Koordinaten System habe ich mich auch noch nicht beschäftigt.... ich würde mich auf euren Tips freuen. Danke sehr im Voraus


Option Explicit

Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim BGpath As String
Dim DocType As Integer
Dim OpenErrors As Long
Dim swAsm As SldWorks.AssemblyDoc

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

    If swApp.ActiveDoc Is Nothing Then
        MsgBox "mach Baugruppe Auf"
        Exit Sub
    End If
    If swModel.GetType <> 2 Then
        MsgBox "mach Baugruppe Auf"
        Exit Sub
    End If
Set swAsm = swModel
BGpath = swModel.GetPathName

Dim CompCount As Long
CompCount = swAsm.GetComponentCount(False)

Dim aComp As Variant
aComp = swAsm.GetComponents(False)

Dim C As Long

    For C = 1 To UBound(aComp)

    Dim swcomp2 As SldWorks.Component2
    Set swcomp2 = aComp(C)

    Dim CompName As String
    CompName = Left(swcomp2.Name2, Len(swcomp2.Name2) - 2)

    Dim CompPath As String
    CompPath = Left(BGpath, Len(BGpath) - 13) & CompName & ".SLDPRT"

    Dim swPartModel As SldWorks.ModelDoc2
    Set swPartModel = swApp.ActivateDoc3(CompPath, False, swRebuildOnActivation_e.swRebuildActiveDoc, OpenErrors)

    Dim SelMgr As SldWorks.SelectionMgr
    Set SelMgr = swPartModel.SelectionManager
   
    Dim EdgeN As Integer
   
    Dim myModelView As Object
    Set myModelView = swPartModel.ActiveView
    myModelView.FrameState = swWindowState_e.swWindowMaximized
    swPartModel.ViewZoomtofit2
    swPartModel.ViewZoomtofit2
    swPartModel.ShowNamedView2 "*Isometrisch", 7
   
    swPartModel.SketchManager.Insert3DSketch True

    'swPartModel.Extension.SelectAll
    'EdgeN = SelMgr.GetSelectedObjectCount2(-1)
    Dim Edg As SldWorks.Edge
    swModel.Extension.SelectByID2 Empty, swSelectType_e.swSelEDGES, Empty, Empty, Empty, True, Empty, Nothing, swSelectOption_e.swSelectOptionDefault
    Edg = SelMgr.GetSelectedObject6(1, -1)
   
    Debug.Print EdgeN = SelMgr.GetSelectedObjectCount2(-1)
   
    Dim swBody As SldWorks.Body2
    Set swBody = Edg.GetBody
    Dim AEdges As Variant
   
    AEdges = swBody.GetEdges
   
    Dim SpecEdg As SldWorks.Edge
    Dim i As Long
        For i = 0 To UBound(AEdges)
        Set SpecEdg = AEdges(i)
        Dim swCurve As SldWorks.Curve
        Set swCurve = SpecEdg.GetCurve
       
    Dim vPts As Variant
    Dim PointsproEdge As Integer
    PointsproEdge = 2
   
    vPts = SplitCurveByPoints(swCurve, PointsproEdge)
    swPartModel.ClearSelection2 True
   
    Dim p As Integer
   
        For p = 0 To (UBound(vPts) + 1) / 3 - 1
        swPartModel.SketchManager.CreatePoint vPts(p * 3), vPts(p * 3 + 1), vPts(i * 3 + 2)
        Next p
       
    Next i
    swPartModel.SketchManager.Insert3DSketch True
    Sketchy (CompName)

  'swPartModel.Save3 8, Empty, Empty
    swApp.CloseDoc CompPath

Next C
End Sub

Function Sketchy(CompName2)
Dim swApp As SldWorks.SldWorks
Dim doc As SldWorks.ModelDoc2
Dim part As SldWorks.PartDoc
Dim sm As SldWorks.SelectionMgr
Dim feat As SldWorks.Feature
Dim Sketch As SldWorks.Sketch
Dim v As Variant
Dim i As Long
Dim sseg As SldWorks.SketchSegment
Dim sline As SldWorks.SketchLine
Dim sp As SldWorks.SketchPoint
Dim ep As SldWorks.SketchPoint
Dim s As String
Dim exApp As Object
Dim Sheet As Object


Set exApp = CreateObject("Excel.Application")
If Not exApp Is Nothing Then
  exApp.Visible = True
  If Not exApp Is Nothing Then
  exApp.Workbooks.Add
  Set Sheet = exApp.ActiveSheet
  If Not Sheet Is Nothing Then
    Sheet.Cells(1, 1).Value = "X"
    Sheet.Cells(1, 2).Value = "Y"
    Sheet.Cells(1, 3).Value = "Z"
    Sheet.Cells(1, 4).Value = CompName2
    Sheet.Cells(1, 5).Value = "A"
    Sheet.Cells(1, 6).Value = "B"
    Sheet.Cells(1, 7).Value = "C"
    Sheet.Cells(2, 5).Value = "=(MAX(A2:A999)-MIN(A2:A999))*1000"
    Sheet.Cells(2, 6).Value = "=(MAX(B2:B999)-MIN(B2:B999))*1000"
    Sheet.Cells(2, 7).Value = "=(MAX(C2:C999)-MIN(C2:C999))*1000"
    Sheet.Cells(4, 8).Value = "A ist maserrichtung? (1 wenn ja, sonst 0)"
  End If
  End If
End If


Set swApp = GetObject(, "sldworks.application")
If Not swApp Is Nothing Then
  Set doc = swApp.ActiveDoc
  If Not doc Is Nothing Then
  If doc.GetType = swDocPART Then
    Set part = doc
    Set sm = doc.SelectionManager
    If Not part Is Nothing And Not sm Is Nothing Then
    If sm.GetSelectedObjectType2(1) = swSelSKETCHES Then
      Set feat = sm.GetSelectedObject4(1)
      Set Sketch = feat.GetSpecificFeature
      If Not Sketch Is Nothing Then
      v = Sketch.GetSketchPoints
      For i = LBound(v) To UBound(v)
        Set sp = v(i)
        If Not sp Is Nothing And Not Sheet Is Nothing And Not exApp Is Nothing Then
        Sheet.Cells(2 + i, 1).Value = (sp.X)
        Sheet.Cells(2 + i, 2).Value = (sp.Y)
        Sheet.Cells(2 + i, 3).Value = (sp.Z)
        exApp.Columns.AutoFit
        End If
      Next i
      End If
    End If
    End If
  End If
  End If
End If
End Function

'**********************
'Copyright(C) 2020 Xarial Pty Limited
'Reference: https://www.codestack.net/solidworks-api/geometry/selected-edge-create-sketch-points/
'License: https://www.codestack.net/license/
'**********************

Function SplitCurveByPoints(swCurve As SldWorks.Curve, pointsNumber As Integer) As Variant
   
    Dim nStartParam As Double
    Dim nEndParam As Double
    Dim bIsClosed As Boolean
    Dim bIsPeriodic As Boolean
   
    Dim incr As Double
    Dim i As Integer
    Dim vParam As Variant
   
    Dim retVal() As Double
   
    ReDim retVal(pointsNumber * 3 - 1)
   
    swCurve.GetEndParams nStartParam, nEndParam, bIsClosed, bIsPeriodic
   
    incr = (nEndParam - nStartParam) / (pointsNumber - 1)
   
    For i = 0 To pointsNumber - 1
   
        vParam = swCurve.Evaluate(nStartParam + i * incr)
       
        retVal(i * 3) = vParam(0)
        retVal(i * 3 + 1) = vParam(1)
        retVal(i * 3 + 2) = vParam(2)
       
    Next
   
    SplitCurveByPoints = retVal
   
End Function

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

ammarasaad3133
Mitglied


Sehen Sie sich das Profil von ammarasaad3133 an!   Senden Sie eine Private Message an ammarasaad3133  Schreiben Sie einen Gästebucheintrag für ammarasaad3133

Beiträge: 3
Registriert: 05.05.2021

erstellt am: 05. Mai. 2021 20:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Ein Problem könnte dass die Bauteile keine Bodies sind? Ich verstehe der Unterschied da nicht ganz...

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

Torsten Niemeier
Ehrenmitglied V.I.P. h.c.
Maschinenbau Ingenieur



Sehen Sie sich das Profil von Torsten Niemeier an!   Senden Sie eine Private Message an Torsten Niemeier  Schreiben Sie einen Gästebucheintrag für Torsten Niemeier

Beiträge: 3682
Registriert: 21.06.2001

"ZUSE I.36", 8 BIT, 32 Lämpchen, Service-Ölkännchen "ESSO-Super", Software: AO auf Kuhlmann-Parallelogramm-Plattform
** CSWP 04/2011 **
** CSWE 08/2011 **

erstellt am: 05. Mai. 2021 21:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für ammarasaad3133 10 Unities + Antwort hilfreich

Kannst Du kurz vorstellen, mit was für Baugruppen und Parts Du es da zu tun hast? Am besten anhand einer hochgeladenen Pack and Go?
Und mich interessiert, was Du da eigentlich vorhast. Mich erinnert das irgendwie ein bisschen an die Sachen, die ich in Computergrafik mit obj-Dateien machen musste (durfte?, unbedingt wollte?).

Willkommen im Forum.
Gruß, Torsten

[Diese Nachricht wurde von Torsten Niemeier am 05. Mai. 2021 editiert.]

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

Christian_W
Ehrenmitglied V.I.P. h.c.
Konstrukteur (Dipl-Ing)


Sehen Sie sich das Profil von Christian_W an!   Senden Sie eine Private Message an Christian_W  Schreiben Sie einen Gästebucheintrag für Christian_W

Beiträge: 3189
Registriert: 04.04.2001

CSWP 12/2015<P>SWX2021sp5 Win10/11
(SWX2016, SWX2012)
proAlpha6.2e00/calinkV9
(Tactonworks)
(Medusa7, NesCAD2010,
solidEdge19)

erstellt am: 06. Mai. 2021 10:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für ammarasaad3133 10 Unities + Antwort hilfreich

Zitat:
... als erstes Projekt ein sehr schweren Projekt aufgenommen ...

Top, der Ansatz  #scnr

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

ammarasaad3133
Mitglied


Sehen Sie sich das Profil von ammarasaad3133 an!   Senden Sie eine Private Message an ammarasaad3133  Schreiben Sie einen Gästebucheintrag für ammarasaad3133

Beiträge: 3
Registriert: 05.05.2021

erstellt am: 06. Mai. 2021 11:10    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Ich arbeite in Solidworks 16, daher kann ich die Festures leider nicht zu Einem Body konvertieren ( erst in SW2017 ), die Aufgabenstellung ist jeden Bauteil in einer Baugruppe aufzumachen in einem Loop
Jeden Bauteil bekommt dann Punkte in jedem Midpoint von jedem Edge
Diese Punkte werden dann mittels die Excel Funktion in einer Tabelle eingetragen
Diese Punkte werden dann mittels Excel „analysiert“ so dass ich die x y Maße der Bruttobauteiö habe, so dass ich in einer andere Excel Tabelle, rechnen kann wie viel Platten ich für ein Baugruppe brauche, also der ultimative Zweck ist sozusagen ein Material bedarf Rechnung

Ich schreibe momentan der Code um, nutze selectAll Befehl um all Kanten auszusuchen, kann mir jemanden sagen wie ich ein Array aus meine Selectionliste erstellen kann

Und vielen Dank für die Rückmeldungen und eure Hilfsbereitschaft

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

bk.sc
Ehrenmitglied V.I.P. h.c.
Konstrukteur Sondermaschinenbau



Sehen Sie sich das Profil von bk.sc an!   Senden Sie eine Private Message an bk.sc  Schreiben Sie einen Gästebucheintrag für bk.sc

Beiträge: 2776
Registriert: 18.07.2012

-Solid Works 2019 SP5
-Pro Engineer WF 3

erstellt am: 10. Mai. 2021 12:57    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für ammarasaad3133 10 Unities + Antwort hilfreich

Hallo,

wenn du schon alle Elemete selectiert hast könntest du dir zu jedem Eintrag im "ISelectionMgr Interface" mit der Methode "GetSelectedObject6 Method (ISelectionMgr) und einer Schleife von 1 bis "GetSelectedObjectCount2 Method (ISelectionMgr)" holen und in das Arry schreiben.

Das Arry könntest du mit ReDim Arrayname (GetSelectedObjectCount2 -1) passend umdimensionieren, "-1" weil das Arry bei 0 anfängt zu Zählen der Count im SelectionMgr jedoch bei 1, alternativ kannst du auch den Eintrag 0 einfach leer lassen, musst dich im Code halt auf eine Variante festlegen.

Als Anhaltspunkt mit der Schleife könnte das Beispiel "Selection Lists Example (VBA)" hilfreich sein.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2024 CAD.de | Impressum | Datenschutz