Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Konturlänge des Pfades eines Sweeps ermitteln

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 Autodesk Produkte
Autor Thema:  Konturlänge des Pfades eines Sweeps ermitteln (989 mal gelesen)
ofencad
Mitglied
Konstrukteur


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

Beiträge: 27
Registriert: 30.10.2015

Windows 7 (64) + Inventor 2016

erstellt am: 09. Nov. 2016 00:18    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

Hallo,

ist es möglich, die Konturlänge eines Pfades, der zum sweepen genutzt wird, zu ermitteln?

Danke für Ansätze

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

Roland Schröder
Ehrenmitglied V.I.P. h.c.
Dr.-Ing. Maschinenbau, Entwicklung & Konstruktion von Spezialmaschinen



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

Beiträge: 13115
Registriert: 02.04.2004

AIP2013SP2.2 XPproSP2 MS-IntelliMouse-Optical SpacePilot
DellM4600 2,13GHz 2GB FxGo1400 1920x1200
am Dock Dell2711

erstellt am: 09. Nov. 2016 01:48    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 ofencad 10 Unities + Antwort hilfreich

Moin!

Ich nehme mal an, dass Du "Messen" nicht meinst... 
Mit dem folgenden (von lieben Forumsgenossen hier unterstützten!) Code habe ich mal herumexperimentiert, es dann aber aufgegeben, denn das lohnte sich für meinen Bedarf nicht so sehr:

Code:

Sub Pfadlaenge_az()
    Dim oPart As PartDocument
    Set oPart = ThisApplication.ActiveDocument
    Dim oSk3D As Sketch3D
    Dim oSkL3D As SketchLine3D
    Dim oSkS3D As SketchSpline3D
    Dim oSkA3D As SketchArc3D
    Dim l As Double
    Dim sLength As String
    Dim sLength2 As String
    Dim oSweep As SweepFeature
    Dim oPathEnt As PathEntity
   
    On Error Resume Next
     
    Dim i As Integer
    For Each oSk3D In objPartdocument.ComponentDefinition.Sketches3D
        For Each oSkL3D In oSk3D.SketchLines3D
            l = Round(oInventorApp.MeasureTools.GetLoopLength(oSkL3D) * 10, 0)
            On Error Resume Next
        Next
    Next
 
    If l = 0 Then    '~~~~~~~~~~~~Nur wenn das vorher nicht geklappt hat
        Set oSweep = oPart.ComponentDefinition.Features.SweepFeatures(1)  ' ~~~~~~~~~~~~~~~~~~~~~~~~Länge über Sweeping ~~
        For Each oPathEnt In oSweep.Path
            If oPathEnt.SketchEntity.Type = kSketchLine3DObject Then
                Set oSkL3D = oPathEnt.SketchEntity
                l = l + oSkL3D.Length
            ElseIf oPathEnt.SketchEntity.Type = kSketchSpline3DObject Then
                Set oSkS3D = oPathEnt.SketchEntity
                l = l + oSkS3D.Length
            ElseIf oPathEnt.SketchEntity.Type = kSketchArc3DObject Then
                Set oSkS3D = oPathEnt.SketchEntity
                l = l + oSkA3D.Length
            Else  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Falls etwas anderes als Line, Spline oder Bogen gefunden wird
                MsgBox ("Unbekannter Segment-Typ! Die Berechnung wird abgebrochen.")
                oPart.SelectSet.Select oPathEnt.SketchEntity
                Exit Sub
            End If
        Next
    End If

    If l = 0 Then    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Falls Länge = 0 Berechnung über die Skizze  ~~~~~~~~~~~~~~~~~~~
        For Each oSk3D In oPart.ComponentDefinition.Sketches3D
            For Each oSkL3D In oSk3D.SketchLines3D
              l = l + oSkL3D.Length
            Next
            For Each oSkS3D In oSk3D.SketchSplines3D
                l = l + oSkS3D.Length
            Next
        Next
    End If
   
    If l <> 0 Then ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~Resultate eintragen und Meldung ausgeben ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        sLength2 = Round(l * 10, 1)
        sLength = Round(l + 0.5, 0) * 10
        Call SetPropertyValueaz(oPart.PropertySets(4), sLength, sLength2)
    Else
        MsgBox ("Die Länge konnte nicht berechnet werden!")
    End If
End Sub


------------------
Roland  
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

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

muellc
Ehrenmitglied V.I.P. h.c.
ICT Specialist



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

Beiträge: 3501
Registriert: 30.11.2006

erstellt am: 09. Nov. 2016 09:47    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 ofencad 10 Unities + Antwort hilfreich

Wir nutzen dafür iLogic:

Code:

Sub Berechnung

    Dim oDoc As PartDocument
    oDoc = ThisApplication.ActiveDocument
   
    Dim oDef As PartComponentDefinition
    oDef = oDoc.ComponentDefinition
   
    Dim opath As Path
    opath = oDef.Features.SweepFeatures.Item("Drahtpfad").Path
   
    Dim TotalLength As Double
    TotalLength = 0
   
    Dim oCurve As Object
    Dim i As Integer

    For i = 1 To opath.Count
        oCurve = opath.Item(i).Curve
       
        Dim oCurveEval As CurveEvaluator
        oCurveEval = oCurve.Evaluator
       
        Dim MinParam As Double
        Dim MaxParam As Double
        Dim length As Double
       
        Call oCurveEval.GetParamExtents(MinParam, MaxParam)
        Call oCurveEval.GetLengthAtParam(MinParam, MaxParam, length)
       
        TotalLength = TotalLength + length
    Next i

Wert1 = Ceil((TotalLength*10-3))

MessageBox.Show("Länge = " & Wert1 & " mm")
End Sub


In der Zeile

Code:
"opath = oDef.Features.SweepFeatures.Item("Drahtpfad").Path"

steht hierbei der Name des Sweepingelements

------------------
Gruß, Gandhi
Kampfkunst Siegen Outdoor Training

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

ofencad
Mitglied
Konstrukteur


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

Beiträge: 27
Registriert: 30.10.2015

Windows 7 (64) + Inventor 2016

erstellt am: 09. Nov. 2016 11:05    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

So, vielen Dank für Eure Ansätze.

Dadurch konnte ich mein Problem folgendermaßen lösen...

CODE:
________________________________________________________________

Sub Schnurlaenge()

    Dim iDoc As PartDocument
    Set iDoc = ThisApplication.ActiveDocument
   
    Dim iPropInfUser As PropertySet
    Set iPropInfUser = iDoc.PropertySets.Item("Inventor User Defined Properties")
    Dim iG_LProperty As property
    Set iG_LProperty = iPropInfUser.Add("G_L")
   
    Dim iDef As PartComponentDefinition
    Set iDef = iDoc.ComponentDefinition
   
    Dim ipath As Path
    Set ipath = iDef.Features.SweepFeatures.Item(1).Path
   
    Dim TotalLength As Double
    TotalLength = 0
   
    Dim Gesamtlänge As String
   
    Dim iCurve As Object
    Dim i As Integer

    For i = 1 To ipath.Count
        Set iCurve = ipath.Item(i).Curve
       
        Dim iCurveEval As CurveEvaluator
        Set iCurveEval = iCurve.Evaluator
       
        Dim MinParam As Double
        Dim MaxParam As Double
        Dim length As Double
       
        Call iCurveEval.GetParamExtents(MinParam, MaxParam)
        Call iCurveEval.GetLengthAtParam(MinParam, MaxParam, length)
       
        TotalLength = TotalLength + length
    Next i

    Überlappung = 100
    Gesamtlänge = Round(TotalLength * 10 + Überlappung, 0)
    iG_LProperty.Value = Gesamtlänge

End Sub

_________________________________________________________________

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)2023 CAD.de | Impressum | Datenschutz