A zmieniając układ współrzędnych X,Y,Z?
1 polubienie
Witam
Być może sztuczką, jeśli raz wygenerowany sześcian już się nie zmienia (?), byłoby umieszczenie objętości (lub wytłoczenie tymczasowego przedłużenia na korpusie), która ograniczałaby prawy górny róg na ostatnim obrazie (czyli co najwyżej wyrównany w prawo z prawą krawędzią niebieskiego obszaru i stos wyrównany u góry z górnym końcem białego obszaru, tak, aby stworzyć tymczasowe ramy, które ten dodatek wymusi wymusić.
Nawiasem mówiąc, działa z każdym rogiem.
1 polubienie
Przy okazji mała wiadomość prewencyjna:
" Pij lub buduj, musisz wybrać!" 
4 polubienia
Witam @a_eriaud
Mam takie makro, które działa dobrze, orientując się zgodnie z XYZ:
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swPart As SldWorks.PartDoc
Set swPart = swApp.ActiveDoc
If Not swPart Is Nothing Then
Dim vBBox As Variant
vBBox = GetPreciseBoundingBox(swPart)
DrawBox swPart, CDbl(vBBox(0)), CDbl(vBBox(1)), CDbl(vBBox(2)), CDbl(vBBox(3)), CDbl(vBBox(4)), CDbl(vBBox(5))
Debug.Print "Width: " & CDbl(vBBox(3)) - CDbl(vBBox(0))
Debug.Print "Length: " & CDbl(vBBox(5)) - CDbl(vBBox(2))
Debug.Print "Height: " & CDbl(vBBox(4)) - CDbl(vBBox(1))
Else
MsgBox "Please open part"
End If
End Sub
Function GetPreciseBoundingBox(part As SldWorks.PartDoc) As Variant
Dim dBox(5) As Double
Dim vBodies As Variant
vBodies = part.GetBodies2(swBodyType_e.swSolidBody, True)
Dim minX As Double
Dim minY As Double
Dim minZ As Double
Dim maxX As Double
Dim maxY As Double
Dim maxZ As Double
If Not IsEmpty(vBodies) Then
Dim i As Integer
For i = 0 To UBound(vBodies)
Dim swBody As SldWorks.Body2
Set swBody = vBodies(i)
Dim x As Double
Dim y As Double
Dim z As Double
swBody.GetExtremePoint 1, 0, 0, x, y, z
If i = 0 Or x > maxX Then
maxX = x
End If
swBody.GetExtremePoint -1, 0, 0, x, y, z
If i = 0 Or x < minX Then
minX = x
End If
swBody.GetExtremePoint 0, 1, 0, x, y, z
If i = 0 Or y > maxY Then
maxY = y
End If
swBody.GetExtremePoint 0, -1, 0, x, y, z
If i = 0 Or y < minY Then
minY = y
End If
swBody.GetExtremePoint 0, 0, 1, x, y, z
If i = 0 Or z > maxZ Then
maxZ = z
End If
swBody.GetExtremePoint 0, 0, -1, x, y, z
If i = 0 Or z < minZ Then
minZ = z
End If
Next
End If
dBox(0) = minX: dBox(1) = minY: dBox(2) = minZ
dBox(3) = maxX: dBox(4) = maxY: dBox(5) = maxZ
GetPreciseBoundingBox = dBox
End Function
Sub DrawBox(model As SldWorks.ModelDoc2, minX As Double, minY As Double, minZ As Double, maxX As Double, maxY As Double, maxZ As Double)
model.ClearSelection2 True
model.SketchManager.Insert3DSketch True
model.SketchManager.AddToDB = True
model.SketchManager.CreateLine maxX, minY, minZ, maxX, minY, maxZ
model.SketchManager.CreateLine maxX, minY, maxZ, minX, minY, maxZ
model.SketchManager.CreateLine minX, minY, maxZ, minX, minY, minZ
model.SketchManager.CreateLine minX, minY, minZ, maxX, minY, minZ
model.SketchManager.CreateLine maxX, maxY, minZ, maxX, maxY, maxZ
model.SketchManager.CreateLine maxX, maxY, maxZ, minX, maxY, maxZ
model.SketchManager.CreateLine minX, maxY, maxZ, minX, maxY, minZ
model.SketchManager.CreateLine minX, maxY, minZ, maxX, maxY, minZ
model.SketchManager.CreateLine minX, minY, minZ, minX, maxY, minZ
model.SketchManager.CreateLine minX, minY, maxZ, minX, maxY, maxZ
model.SketchManager.CreateLine maxX, minY, minZ, maxX, maxY, minZ
model.SketchManager.CreateLine maxX, minY, maxZ, maxX, maxY, maxZ
model.SketchManager.AddToDB = False
model.SketchManager.Insert3DSketch True
End Sub
Moje zespoły są zawsze równoległe do górnych płaszczyzn, a więc normalne do Y, ale niekoniecznie równoległe do X (lub Z).
Nie wiem, czy funkcje makr VBA pozwoliłyby, wybierając z góry twarz, która byłaby odniesieniem do orientacji, na wygenerowanie dobrze zorientowanego szkicu 3D...
Jeśli ktoś ma pomysł, jak to zrobić w makro, jestem zainteresowany 
Witam
Rzeczywiście, może być coś wspólnego z tym makro...
Ale nie wiem o tym wystarczająco dużo, żeby zacząć...
Myślę, że musiałbyś zagłębić się w funkcję " GetExtremePoint ", aby znaleźć punkt skrajny, pozostając równoległym do płaszczyzny.
To tylko pomysł...
Myślę, że na tym forum są profesjonaliści makro, niektórzy już mi bardzo pomogli...
Miłego weekendu z wyprzedzeniem.
2 polubienia
Witaj @MLG ,
Jeśli zachowamy ideę " sześcianu obwiedniowego " (w rzeczywistości prostokątnego równoległościanu), trzy płaszczyzny generujące są prostopadłe. Po wybraniu pierwszego z nich wystarczy podać kierunek w tej płaszczyźnie, aby trójścian był całkowicie związany.
Wychodząc od makra Codestack zaproponowanego przez @MLG i przeznaczonego dla części, uważamy, że po prostu musimy dostosować je do montażu, zamiatając części drzewa konstrukcyjnego i wymuszając kierunki rzutowania.
Prosty z wyglądu, ale kilka przewidywanych chwil zamienia się w godziny. Na szczęście pogoda była ponura...
Wynik jest dostępny w załączonym makrze. Sposób użycia:
- Złożenie musi zostać otwarte w SolidWorks.
- Płaszczyzna i kierunek (prosta krawędź lub segment szkicu) są wybierane w tej kolejności w obszarze graficznym.
- Makro zostanie wykonane.
Wyniki:
- Sześcian otoczki jest wyświetlany jako szkic trójwymiarowy (3D) w zespole.
- krawędzie modułu są określone w formularzu UserForm.
Słabością w porównaniu z " kostką wizualizacji " SolidWorks jest to, że sześcian obwiedni jest zamrożony na geometrii w momencie jej tworzenia. Dalsza ewolucja form montażu nie będzie brana pod uwagę.
Jak zawsze, makro bez zabezpieczeń, bez gwarancji wyników, do testowania zwłaszcza na dużych zespołach.
Pozdrowienia.
Zmodyfikowane makro, do pobrania poniżej...
5 polubień
Witam @m_blt
Przeszedłem przez kod i jest praca do wykonania!! DOBRA ROBOTA 
Z drugiej strony testowałem na jednym z moich montaży, ale nic się nie dzieje.
Brak komunikatu o błędzie, nawet jeśli wymuszę to, uruchamiając makro na monecie.
Co z tego co udało mi się zobaczyć w kodzie powinno mi wygenerować okienko z ostrzeżeniem.
Masz pomysł, co robić?
1 polubienie
Podczas uruchamiania głównego suba z edytora za pomocą F8 pokazuje mi błąd brakującego projektu lub biblioteki:
A patrząc na błąd lepiej rozumiem brakującą bibliotekę (SW2023)
Może masz ten sam problem. Którą wersję oprogramowania posiadasz?
@m_blt Chciałem rzucić okiem z ciekawości i zainteresowania, ponieważ ogólnie rzecz biorąc, twoje makra mnie urzekają!
Edit: odznaczając czego brakuje i sprawdzając 3 biblioteki w wersji 2020 działa!
Po raz kolejny jestem zdumiony tym kodem:
3 polubienia
Makro nie działa na części, ponieważ przechodzi przez drzewo budowania złożenia. Już tam powinien być ten komunikat:
Osobiście testowałem makro na kilku złożeniach, z których " najcięższy " miał 278 części, nie zauważając żadnej anomalii. Jeśli makro zostanie uruchomione bez wybierania żadnych obiektów, powinna być przynajmniej widoczna karta UserForm.
Potwierdzam podejrzenia @sbadenis : usterka może być spowodowana brakiem pewnych odniesień do obiektów VBA. Oto te, których używam z wersją 2023 SolidWorks:
Sprawdź również, czy wyświetlacz szkicu jest aktywowany w złożeniu, nigdy nie wiadomo...
Kolejna wskazówka: makro zostało napisane za pomocą SW 2023. Być może nie ma żadnej funkcji, jeśli używasz starszej wersji. Nawet jeśli powinien zostać wyświetlony komunikat o błędzie... Sądząc po ilustracji jego przesłania, @sbadenis sprawiło, że zadziałało to w wersji z 2020 roku
Czy zespół, na którym testowałeś makro, ma jakąś cechę, która uniemożliwia jego poprawne działanie? Powinieneś udostępnić jeden ze swoich zestawów i określić, której wersji oprogramowania używasz.
2 polubienia
@m_blt
Kiedy widzę tę pracę, mówię sobie, że nadszedł czas, abym wziął tangens, który jest równoległy do płaszczyzny. Poza tym dobra oferta jest zawsze mile widziana.
C dlt
4 polubienia
Zastosowałem zmiany w referencjach, sprawdzając 2022 dla mojej wersji:
A makro działało dobrze, jest TOP @m_blt 
:
Właśnie zmieniłem ptLoc długości i głębokości sześcianu, które dla mnie były odwrócone (ptLoc(4) i (1)), a także precyzję, aby nie mieć ułamka dziesiętnego:
UserForm1.Label3.Caption = "Longueur du cube : " & Format(longueur(ptLoc(0), ptLoc(4)), "#####0")
UserForm1.Label4.Caption = "Largeur du cube : " & Format(longueur(ptLoc(0), ptLoc(2)), "#####0")
UserForm1.Label5.Caption = "Profondeur du cube : " & Format(longueur(ptLoc(0), ptLoc(1)), "#####0")
Jest IDEALNY.
Z drugiej strony chciałbym pobrać te wartości i skojarzyć je ze zmiennymi we wszystkich konfiguracjach, ale nie wiem gdzie i jak (sub, funkcja ...) Muszę wstawić to:
Dim i As Integer
Dim tConfig() As String
Dim swErrors As Long
Dim swWarnings As Long
Do
'récupère le document actif dans SW
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
'Boucle sur toutes les configurations
tConfig = swModel.GetConfigurationNames
For i = 0 To UBound(tConfig)
'ajoute un propriété personnalisée "DIM-Lo"
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DIM-Lo")
bRet = swModel.AddCustomInfo3(tConfig(i), "DIM-Lo", swCustomInfoText, Chr(34) & Format(longueur(ptLoc(0), ptLoc(4)), "#####0") & Chr(34))
'ajoute un propriété personnalisée "DIM-La"
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DIM-La")
bRet = swModel.AddCustomInfo3(tConfig(i), "DIM-La", swCustomInfoText, Chr(34) & Format(longueur(ptLoc(0), ptLoc(2)), "#####0") & Chr(34))
'ajoute un propriété personnalisée "DIM-Ha"
'Chr(34) permet d'ajouter le caractère "
bRet = swModel.DeleteCustomInfo2(tConfig(i), "DIM-Ha")
bRet = swModel.AddCustomInfo3(tConfig(i), "DIM-Ha", swCustomInfoText, Chr(34) & Format(longueur(ptLoc(0), ptLoc(1)), "#####0") & Chr(34))
Next i
Czy masz dla mnie jakiś trop?
Witam @m_blt Bravo i dziękuję za makro. Tylko mała sugestia; Określ osie xyz wskazanych wymiarów, na przykład w nawiasach, ponieważ szerokość i długość, głębokość jest co najmniej względna.
1 polubienie
Cze wszystkim
Ostatnia (?) odpowiedź...
- Trzy wymiary sześcianu obwiedni są zapisywane jako właściwości we wszystkich konfiguracjach złożenia;
- Aby spełnić życzenie @Sylk
, dodałem lokalny układ współrzędnych w początku sześcianu, którego osie są wyrównane z krawędziami. W celu identyfikacji kierunków X, Y i Z.
Wydaje mi się, że dla @MLG jest to kolejność wysokości (X), długości (Y) i głębokości (Z).
Kolejność można łatwo zmienić na liniach od 322 do 334.
Mały obraz do zlokalizowania wierzchołków sześcianu.
Pozdrowienia.
Plik CubeVisuAssembly.swp (223 KB)
2 polubienia
Jeszcze raz dziękuję @m_blt
Działa bardzo dobrze 
Mam różnicę w dokładności wyników między oknem dialogowym a zmiennymi we właściwościach (F8):
Precyzja jest podawana w jednostkach (bez miejsc dziesiętnych) w oknie dialogowym
Dokładność wynosi 6 miejsc po przecinku
Jednak zastosowałem ten sam FORMAT w kodzie między tym, co jest wyświetlane w oknie dialogowym i we właściwościach (F8):
Dim valLONG As Variant
Dim valLARG As Variant
Dim valHAUT As Variant
Set ptLoc(0) = creationPt(min(0), min(1), min(2))
Set ptLoc(1) = creationPt(max(0), min(1), min(2))
Set ptLoc(2) = creationPt(min(0), max(1), min(2))
Set ptLoc(3) = creationPt(max(0), max(1), min(2))
Set ptLoc(4) = creationPt(min(0), min(1), max(2))
Set ptLoc(5) = creationPt(max(0), min(1), max(2))
Set ptLoc(6) = creationPt(min(0), max(1), max(2))
Set ptLoc(7) = creationPt(max(0), max(1), max(2))
For iPt = 0 To 7
Set ptLoc(iPt) = ptLoc(iPt).MultiplyTransform(RgToCube)
Next iPt
TraceBox ptLoc
lgAreteCube(0) = CalculLongueur(ptLoc(0), ptLoc(1))
lgAreteCube(1) = CalculLongueur(ptLoc(0), ptLoc(2))
lgAreteCube(2) = CalculLongueur(ptLoc(0), ptLoc(4))
UserForm1.Label3.Caption = "DIM-Lo : " & Format((lgAreteCube(2) / 10), "#####0")
UserForm1.Label4.Caption = "DIM-La : " & Format((lgAreteCube(0) / 10), "#####0")
UserForm1.Label5.Caption = "DIM-Ha : " & Format((lgAreteCube(1) / 10), "#####0")
UserForm1.CommandButton3.Enabled = True
valLONG = (Format((lgAreteCube(2) / 10), "#####0"))
valLARG = (Format((lgAreteCube(0) / 10), "#####0"))
valHAUT = (Format((lgAreteCube(1) / 10), "#####0"))
swConfNames = swModel.GetConfigurationNames ' Liste des noms de configurations
For iPt = LBound(swConfNames) To UBound(swConfNames) ' Boucle sur les configs
Set swCstPropMgr = swModel.Extension.CustomPropertyManager(swConfNames(iPt))
swCstPropMgr.Add3 "DIM-Lo", swCustomInfoDouble, valLONG, swCustomPropertyReplaceValue
swCstPropMgr.Add3 "DIM-La", swCustomInfoDouble, valLARG, swCustomPropertyReplaceValue
swCstPropMgr.Add3 "DIM-Ha", swCustomInfoDouble, valHAUT, swCustomPropertyReplaceValue
Next iPt
End Sub
Testowałem, zmieniając ułamki dziesiętne w ustawieniach mojego modułu programowego, ale to nic nie zmienia.
Czy masz pojęcie, skąd bierze się problem?
1 polubienie
Ponieważ nie chcesz ułamków dziesiętnych, najprostszym sposobem jest przekonwertowanie zmiennej lgAreteCube z typu Double na Integer , w instrukcji generowania właściwości.
Wymiana linii:
swCstPropMgr.Add3 "CubEnvLongueurY", swCustomInfoNumber, CInt(lgAreteCube(1)), swCustomPropertyReplaceValue
Według niego:
swCstPropMgr.Add3 "CubEnvLongueurY", swCustomInfoNumber, CInt(lgAreteCube(1)), swCustomPropertyReplaceValue
Do dostosowania zgodnie z Twoimi ocenami.
Jeśli szukasz bardziej szczegółowego formatu, będziesz musiał użyć ciągów...
2 polubienia
Jeszcze raz dziękuję @m_blt
Działa bardzo dobrze.
Od wczoraj szukam na Codestack, czy istnieje sposób na nazwanie szkicu 3D po jego wykonaniu, lub na pobranie nazwy ostatniego szkicu utworzonego w drzewie.
Ale nic na ten temat nie mogłem znaleźć.
Potrzebowałbym tego, aby dodać usunięcie szkicu 3D na końcu makra, aby wyczyścić nasze zespoły po pobraniu zmiennych.
Kiedy patrzę na ten kod wygenerowany w Solidworks z pierwszym usunięciem szkicu 2D, a następnie usunięciem szkicu 3D, nie ma żadnej różnicy w syntezie, z wyjątkiem nazwy funkcji. Niezależnie od tego, czy jest to 2D, czy 3D, pojawia się " SZKIC ":
boolstatus = Part.Extension.SelectByID2("Esquisse3D1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.EditDelete
boolstatus = Part.Extension.SelectByID2("Esquisse1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Part.EditDelete
Czy wiesz, jak postępować?
Z góry dziękuję
1 polubienie
Witam
W rekordzie UserForm1 znajduje się przycisk [Wyczyść], który usuwa szkic 3D i układ współrzędnych skojarzony z modułem. Pod warunkiem, że są to dwie ostatnie funkcje drzewa, tak aby po utworzeniu kostki nic nie było dodawane.
Jeśli chodzi o pobieranie nazwy szkicu, metoda " Name " jest częścią klasy " ISketch " interfejsu API (" swSketch.Name ", patrz wiersz 377).
Jeśli jednak istnieje zmienna wskazująca na szkic, taka jak linia 363 (" Set swSketch = swModel.SketchManager.ActiveSketch "), metoda " Select4() " umożliwia wybór bez konieczności szukania jej nazwy, na przykład:
" ok = swSketch.Select4(False, Nothing) "
Prawdopodobnie odziedziczone członkinie, nie są udokumentowane w pomocy klasy " ISketch ", ale są udokumentowane w innych...
1 polubienie
Witam @m_blt
Jeszcze raz dziękujemy za Twoją opinię.
Właściwie nie nacisnąłem przycisku DELETE.
Przyjrzę się temu bliżej, aby zobaczyć, kiedy działa w odniesieniu do informacji o zmiennych, które dodałem... i wzbogacić moje ubóstwo intelektualne w VBA.
Nawiasem mówiąc, w VBA majstrowałem przy tym dziś rano...
Makro, które pobiera nazwę ostatniej funkcji w celu jej usunięcia.
Ponieważ istnieje szkic 3D i trójścian, podwajam wiersze poleceń, aby usunąć 2 funkcje.
Wiem, to archaiczne 
Z pewnością jest sposób, aby to uprościć, myślę...
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swAssembly As SldWorks.AssemblyDoc
Dim swFeatureName As SldWorks.Feature
Sub SuppressionDeuxDernieresFonctions()
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
' Vérifie que le document SW est ouvert
If swDoc Is Nothing Then
MsgBox "Aucun document Solidworks ouvert"
Exit Sub
End If
Set swAssembly = swDoc
'''Première passe pour supprimer le trièdre
'Attribution nom dernière fonction
Set swFeatureName = swDoc.Extension.GetLastFeatureAdded
'Vérifie la selection de la fonction
If swFeatureName Is Nothing Then
MsgBox "Sélection fonction impossible"
swDoc.ClearSelection2 True
Exit Sub
End If
'Selection du nom
swFeatureName.Select True
'Suppression de la fonction
swDoc.EditDelete
'''Deuxième passe pour supprimer l'esquisse 3D
'Attribution nom dernière fonction
Set swFeatureName = swDoc.Extension.GetLastFeatureAdded
'Vérifie la selection de la fonction
If swFeatureName Is Nothing Then
MsgBox "Selection fonction Impossible"
swDoc.ClearSelection2 True
Exit Sub
End If
'Selection du nom
swFeatureName.Select True
'Suppression de la fonction
swDoc.EditDelete
End Sub
1 polubienie
Witam @m_blt
Mam małe pytanie odnośnie definicji układu pudełka.
Mam kilka przypadków, w których nie pasuje do maksimum tego, co powinno być. W szczególności na okrągłych częściach z zaokrągleniami:
Mam obudowę na 2 sztukach po prawej i lewej stronie:
Ale nie mam etui na górnym kawałku:
Gdzie w kodzie mogę interweniować, aby uzyskać dobrą styczność?
W każdym razie makro działa świetnie.
Przywiozłem swoje aranżacje i dodatkowe funkcje i jest SUPER.
Bardzo dziękuję za udzieloną pomoc.
Z góry dziękuję.
Witam
Trudno powiedzieć, jakie jest źródło problemu, o którym mówisz. Kilka uwag:
-
Jaka jest skala błędu w porównaniu z ogólnymi wymiarami zespołu (na przykład w mm)?
-
O ile zaobserwowana wada wymaga znacznego zoomu, winny może być wyświetlacz...
-
Metoda " GetExtremePoint() " określa zewnętrzną granicę dla każdej części. Jest to obliczenie numeryczne wewnętrzne dla interfejsów API SolidWorks. Czy jest rygorystyczny? Jak każde obliczenie numeryczne, używa kryterium jakości do walidacji wyszukiwania, kryterium nieznanego użytkownikowi.
W tym punkcie, Pomoc SolidWorks wypowiedziała się na temat funkcji " GetBodyBox ", która najwyraźniej używa metody " GetExtremePoint ":
WAŻNE: Zwrócone wartości są przybliżone i nie powinny być używane do celów porównawczych lub obliczeniowych. Ponadto obwiednia może ulec zmianie po przebudowaniu modelu.
Kontury " chmur" widoczne na zrzutach ekranu wydają się być oparte na splajnach. Czy to może być pochodzenie pb?
- Jedynymi obliczeniami wewnątrz makra są zmiany układu współrzędnych, które korzystają z funkcji wektorowych i rastrowych interfejsu API. Nie widzę, w jaki sposób mogą wygenerować wadę.
Podsumowując: nie jestem w stanie zidentyfikować źródła problemu. Czy możesz podzielić się przykładem, który jest problematyczny? Nawet jeśli zostanie zdegradowany, lub przez prywatną wiadomość...
Pozdrowienia.
4 polubienia