Visualisierungs-Würfel

Maclane · 12. August 2026 um 07:22

Bah!
Um manuell zu dimensionieren, kann man das genauso gut machen, ohne das Makro durchzugehen, schließlich sind es nur drei Dimensionen, die zu einem Würfel hinzugefügt werden müssen.
Naiv dachte ich, ich könnte sie leicht direkt in den Makrocode einfügen, aber entweder mache ich es sehr falsch (das ist durchaus möglich), oder die Dimensionierung in eine 3D-Skizze über die APIs einzufügen ist nicht so einfach.
Der @m_blt Code liefert jedoch alle notwendigen Informationen (oder mehr).
=> Ich habe den Punktnamen
=> Ich habe den Skizzennamen
=> Ich habe den Namen des Markers
und ich habe sogar Entfernungen zu den 3 X, Yet Z-Koordinaten...
Und bei all dem... Nun, ich bin auf dem Weg ...

m_blt · 12. August 2026 um 07:41

Hallo @Maclane ,

Entschuldigung für die späte Antwort...
Es ist nicht einfach, eine 3D-Skizze in einem Makro dimensioniert zu gestalten.
Die Kopfschmerzen bestehen darin, die Lage der Quoten genau zu definieren. Normalerweise lassen wir SW das machen und rechieren es dann " von Hand ".

Im Makro "Visualisierungswürfel " zeichnet die Sub TraceBox(ptLoc() As MathVector)- Funktion die Box. Ich habe ein paar Zeilen hinzugefügt:

um die drei Seiten der Länge der Ecken der Box vom Ursprungspunkt P0 am besten zu platzieren.
um eine " Fixed "-Bedingung auf die acht Eckpunkte der Box anzuwenden, um die Skizze einzufrieren.
Um Referenzpunkte zu den Eckpunkten der Box zu erstellen, was im Debug-Modus nützlich ist, um diese Knoten zu identifizieren. Teil des Codes, um im Standardmodus zu kommentieren.

Das Ergebnis:

Prinzipiell reicht es aus, die ursprüngliche TraceBox-Funktion durch die untenstehende zu ersetzen.

Sub TraceBox(ptLoc() As MathVector)

        Dim swFeat          As Feature
        Dim swRefPt         As RefPoint
        Dim swFeatMgr       As FeatureManager
        Dim matProps(8)     As Double
        Dim skSegment(11)   As SketchSegment
        Dim swSketch        As Sketch
        Dim posCote(2)      As Double
        Dim noPt            As Long
        Dim boolStatus      As Boolean
        Dim vRefPoint       As Variant
        Dim bInputDimPref   As Boolean
        Dim swDisplayDim    As DisplayDimension
        Dim i               As Long

    swModel.SketchManager.Insert3DSketch True
    swModel.SketchManager.AddToDB = True
    
    Set skSegment(0) = traceLigne(ptLoc, 0, 1)
    Set skSegment(1) = traceLigne(ptLoc, 0, 2)
    Set skSegment(2) = traceLigne(ptLoc, 2, 3)
    Set skSegment(3) = traceLigne(ptLoc, 1, 3)
    
    Set skSegment(4) = traceLigne(ptLoc, 4, 5)
    Set skSegment(5) = traceLigne(ptLoc, 4, 6)
    Set skSegment(6) = traceLigne(ptLoc, 6, 7)
    Set skSegment(7) = traceLigne(ptLoc, 5, 7)
    
    Set skSegment(8) = traceLigne(ptLoc, 0, 4)
    Set skSegment(9) = traceLigne(ptLoc, 1, 5)
    Set skSegment(10) = traceLigne(ptLoc, 3, 7)
    Set skSegment(11) = traceLigne(ptLoc, 2, 6)
    
    ' Contrainte "Fixe" des sommets de la boite
    For noPt = LBound(ptLoc) To UBound(ptLoc)
        boolStatus = swModel.Extension.SelectByID2("", "SKETCHPOINT", ptLoc(noPt).ArrayData(0), ptLoc(noPt).ArrayData(1), ptLoc(noPt).ArrayData(2), False, 0, Nothing, 0)
        If boolStatus Then
            swModel.SketchAddConstraints "sgFIXED"      ' Sommet fixé
        End If
    Next noPt
    
    ' Cotation des arêtes de la boite
    bInputDimPref = swApp.GetUserPreferenceToggle(swUserPreferenceToggle_e.swInputDimValOnCreate)
    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False
    
    ' Cote de l'arête / X
    swModel.ClearSelection2 True
    For i = 0 To 2
        posCote(i) = ptLoc(0).ArrayData(i) * 3 / 4 + ptLoc(1).ArrayData(i) / 2 - ptLoc(4).ArrayData(i) / 4
    Next i
'    swModel.SketchManager.CreatePoint posCote(0), posCote(1), posCote(2)
    skSegment(8).Select4 False, Nothing
    skSegment(9).Select4 True, Nothing
    Set swDisplayDim = swModel.AddDimension2(posCote(0), posCote(1), posCote(2))

    ' Cote de l'arête / Y
    swModel.ClearSelection2 True
    For i = 0 To 2
        posCote(i) = ptLoc(0).ArrayData(i) * 3 / 4 + ptLoc(2).ArrayData(i) / 2 - ptLoc(4).ArrayData(i) / 4
    Next i
'    swModel.SketchManager.CreatePoint posCote(0), posCote(1), posCote(2)
    skSegment(8).Select4 False, Nothing
    skSegment(11).Select4 True, Nothing
    Set swDisplayDim = swModel.AddDimension2(posCote(0), posCote(1), posCote(2))

    ' Cote de l'arête / Z
    swModel.ClearSelection2 True
    For i = 0 To 2
        posCote(i) = ptLoc(0).ArrayData(i) * 3 / 4 + ptLoc(4).ArrayData(i) / 2 - ptLoc(1).ArrayData(i) / 4
    Next i
'    swModel.SketchManager.CreatePoint posCote(0), posCote(1), posCote(2)
    skSegment(0).Select4 False, Nothing
    skSegment(4).Select4 True, Nothing
    Set swDisplayDim = swModel.AddDimension2(posCote(0), posCote(1), posCote(2))

    swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, bInputDimPref
    swModel.ClearSelection2 True
    
    ' Réactualiser l'affichage
    swModel.ClearSelection2 True
    swModel.GraphicsRedraw2
    
    Set swSketch = swModel.SketchManager.ActiveSketch
    swModel.SketchManager.AddToDB = False
    swModel.SketchManager.Insert3DSketch True
    
    
'''    ' Création de points de référence aux sommets de la boite
'''    Set swFeatMgr = swModel.FeatureManager
'''    For noPt = LBound(ptLoc) To UBound(ptLoc)
'''        boolStatus = swModel.Extension.SelectByID2("", "EXTSKETCHPOINT", ptLoc(noPt).ArrayData(0), ptLoc(noPt).ArrayData(1), ptLoc(noPt).ArrayData(2), False, 0, Nothing, 0)
'''        If boolStatus Then
'''            vRefPoint = swFeatMgr.InsertReferencePoint(swRefPointSketchPoint, 0, 0.01, 1)       ' Création d'un point de référence
'''            Set swFeat = vRefPoint(0)
'''            swFeat.Name = "Pt" & CStr(noPt)
'''        End If
'''    Next noPt
    
    
    Set swFeat = swModel.FeatureByPositionReverse(0)
    matProps(0) = 0#: matProps(1) = 162# / 255#: matProps(2) = 175# / 255#     'Couleur turquoise
    matProps(3) = 1: matProps(4) = 1: matProps(5) = 0.5
    matProps(6) = 0.4: matProps(7) = 0: matProps(8) = 0
    swFeat.SetMaterialPropertyValues2 matProps, swThisConfiguration, Empty
    UserForm1.Show
    swModel.ForceRebuild3 True
    swModel.ClearSelection2 (True)
        
    swModel.Extension.SelectByID2 "", "EXTSKETCHPOINT", ptLoc(0).ArrayData(0), ptLoc(0).ArrayData(1), ptLoc(0).ArrayData(2), False, 1, Nothing, 0
    swModel.Extension.SelectByID2 skSegment(0).GetName & "@" & swSketch.Name, "EXTSKETCHSEGMENT", 0#, 0#, 0#, True, 2, Nothing, 0
    swModel.Extension.SelectByID2 skSegment(1).GetName & "@" & swSketch.Name, "EXTSKETCHSEGMENT", 0#, 0#, 0#, True, 4, Nothing, 0
    swModel.FeatureManager.InsertCoordinateSystem False, False, False

End Sub

Maclane · 12. August 2026 um 08:21

Arrrrgggghhhhh!

=> die Punkte setzen... !! DIE !! PUNKTE BEHEBEN
… pfff, aber verdammt, ich wusste, dass ich auf dem richtigen Weg war.

nun, ich hatte auch vergessen:

swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False

Deshalb hat es nicht so gut funktioniert.
Danke @m_blt und Hut ab.
(nicht so einfaches Makrozitat, oder?)

m_blt · 12. August 2026 um 14:21

Vor allem braucht man ein Blatt Papier und einen Stift in der Nähe der Tastatur, um die Darstellungen von SW zu bereichern...

Es ist immer noch vollständiger und ästhetischer als das: