Tabela tolerancji w rysunku

kacper.suchomski · ‎09-28-2018

W Autodesk Inventor potrzebna jest tabela tolerancji w rysunku. Takie rozwiązanie ma AutoCAD Mechanical.

l.poturala · ‎05-20-2020

' Inventor 2021 Profesional (legalne) iLogic
' Program do wstawiania tabeli wymiarów tolerowanych oraz inspekcyjnych. 
' Wymiary które projektant chce żeby były sprawdzone oraz ułatwić produkcji wykonanie.  
' Kod udostępniam bez żadnych zastrzeżeń dla celów edukacyjnych oraz do wykorzystania w codziennej pracy.
' Wykorzystać kod można na własną odpowiedzialność.
' Nie odpowiadam za ewentualne błędy powstałe w wyniku działania w całości ani w części.
' Leszek Poturała 10.05.2020
Sub Main

Dim oDrawDoc As DrawingDocument 
	oDrawDoc = ThisApplication.ActiveDocument

Dim oSheet As Sheet
	oSheet = oDrawDoc.ActiveSheet 
Dim oDim As DrawingDimension

Dim oUpperTol, oLowerTol, oModelValue As String

Dim Tolerancja As String


'Const kBasicTolerance = 31245
'Const kDefaultTolerance = 31233
'Const kDeviationTolerance = 31236
'Const kLimitLinearTolerance = 31238
'Const kLimitsFitsLinearTolerance = 31242
'Const kLimitsFitsShowSizeTolerance = 31243
'Const kLimitsFitsShowTolerance = 31244
'Const kLimitsFitsStackedTolerance = 31241
'Const kLimitsStackedTolerance = 31237
'Const kMaxTolerance = 31239
'Const kMinTolerance = 31240 
'Const kOverrideTolerance = 31234 
'Const kReferenceTolerance = 31246 
'Const kSymmetricTolerance = 31235


Dim oNorma As New ArrayList

     oNorma.Add("ISO 2768-1 f(dokładna)")
	 oNorma.Add("ISO 2768-1 m(średnia)")
	 oNorma.Add("ISO 2768-1 c(zgrubna)")
	 oNorma.Add("ISO 2768-1 v(bardzo zgrubna)")

				
MultiValue.List("Norma") = oNorma
For Each oSheet In oDrawDoc.Sheets
	k = 4'columny-kolumny
	k=k-1
	
	i = 0
	j = 0
	m = 0
	
		oSheet.Activate	' aktywacja arkusza oraz odczytanie wymiarów
		
		For Each oDim In oSheet.DrawingDimensions
				Tolerancja = oDim.Tolerance.ToleranceType
			If (Tolerancja <> 31233 Or oDim.IsInspectionDimension = True) Then
				i = i + 1
			End If	
		Next


		Dim oContents(i * 4) As String

		Tolerancja = oDim.Tolerance.ToleranceType
				
			For Each oDim In oSheet.DrawingDimensions
				Tolerancja = oDim.Tolerance.ToleranceType
				If (Tolerancja<>31233  Or oDim.IsInspectionDimension = True) Then
					'Odczyt wymiarów Przypisanie wartości w tabeli

						'sprawdzenie czy wymiar liniowy czy średnica
						oModelValueHole = oDim.Type '117474560-Liniowy; 117475328-Średnica
						If oDim.Type=117474560 Then 
							oContents(j) = oDim.ModelValue * 10 'wymiar podstawowy- mm
						ElseIf oDim.Type=117475328 Then
							oContents(j) = "Ø" & oDim.ModelValue * 10 'wymiar podstawowy- mm
						End If
					
						'Pole tolerancji lub wymiar inspekcyjny			
						If (oDim.Tolerance.ShaftTolerance <> "" And (Tolerancja =31241 Or Tolerancja =31242 Or Tolerancja =31243 Or Tolerancja =31244)) Then
							
							oContents(j+1)=oDim.Tolerance.ShaftTolerance 'Pasowanie wałek

						ElseIf (oDim.Tolerance.HoleTolerance <> "" And (Tolerancja =31241 Or Tolerancja =31242 Or Tolerancja =31243 Or Tolerancja =31244))Then
							
							oContents(j+1) = oDim.Tolerance.HoleTolerance ' Pasowanie otwór

						ElseIf (oDim.IsInspectionDimension = True And (oDim.Tolerance.ToleranceType = 31233)) Then 'Sprawdzenie wymiaru
							r = InputListBox("Norma", MultiValue.List("Norma"), "ISO 2768-1 m(średnia)", Title := "Wybór Normy", ListName := "Wybierz Normę")
							z = Odchylka(r, oDim.ModelValue*10)
							nor=WNorma(r)						

							oContents(j + 1) = nor 'norma ogólna tolerancji
							oContents(j + 2) = z 'odchyłka
						ElseIf oDim.Tolerance.ToleranceType = 31245 Then 'Podstawowy
							r = InputListBox("Norma", MultiValue.List("Norma"), "ISO 2768-1 m(średnia)", Title := "Wybór Normy", ListName := "Wybierz Normę")
							z = Odchylka(r, oDim.ModelValue*10)
							nor=WNorma(r)						

							oContents(j + 1) = nor 'norma ogólna tolerancji
							oContents(j + 2) = z 'odchyłka

						End If
					
						'odchyłka
						If Tolerancja = 31235 Then
							oContents(j+2)="±" & oDim.Tolerance.Upper

						ElseIf (Tolerancja = 31236 Or Tolerancja =31241 Or Tolerancja =31242 Or Tolerancja =31243 Or Tolerancja =31244) Then
							oUpperTol = oDim.Tolerance.Upper * 10
							oLowerTol = oDim.Tolerance.Lower * 10
					
							oContents(j + 2) = "  " & oUpperTol & "  " & oLowerTol
						ElseIf Tolerancja = 31239 Then
							oContents(j + 2) = "MAX"
						ElseIf Tolerancja = 31240 Then
							oContents(j + 2) = "MIN"
						End If
				oContents(j + 3) = " "
				m = m + 1
				j = m * 4
				End If
			Next
			
			'------------------------TABELA------------------------
	If j<>0 Then
		Dim oTitles(3) As String'4
			oTitles(0) = "Wymiar"
			oTitles(1) = "Pasowanie"
			oTitles(2) = "Odchyłka"
			oTitles(3) = "Wymiar rzeczywisty"
		' Ustaw szerokość kolumny (domyślnie szerokość tytułu kolumny, jeśli nie jest określona)
		Dim oColumnWidths(3) As Double
			oColumnWidths(0) = 1
			oColumnWidths(1) = 1
			oColumnWidths(2) = 1
			oColumnWidths(3) = 1
		
		Dim oContents1(j-1) As String
			For a = 0 To j - 1
				If oContents(a) = "" Then
					oContents(a) = " "
					oContents1(a) = " "

				Else
					oContents1(a) = oContents(a)
				End If
			Next
		
If ActiveSheet.TitleBlock = "Rysunkowa" Then
		X = ActiveSheet.Width
		Y = ActiveSheet.Height
		If X<=210 Then ' A4 rysunkowy
			oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(X / 10 - 5.58, Y / 10 - 1)
		ElseIf X>210 Then 'A3 rysunkowy
			oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(X / 10 - 5.78, Y / 10 - 1)
		End If

ElseIf ActiveSheet.TitleBlock = "Technologiczna" Then
		X = ActiveSheet.Width
		Y = ActiveSheet.Height
		
		If X<=210 Then ' A4 technologiczny
			oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(X / 10 - 5.58, Y / 10 - 5.5)
		ElseIf X>210 Then 'A3 technologiczny
			oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(X / 10 - 5.78, Y / 10 - 5.5)
		End If

		
End If
	
		
		' Utworzenie tabeli tolerancji
		Dim oCustomTable As CustomTable

			If oSheet.CustomTables.Count>0 Then
				oSheet.CustomTables.Item(1).Delete
			End If

		oCustomTable = oSheet.CustomTables.Add("TABELA TOLERANCJI", oPlacementPoint, 4, j / 4, oTitles, oContents1, oColumnWidths)
		
		oCustomTable.Columns.Item(1).ValueHorizontalJustification = kAlignTextCenter
		oCustomTable.Columns.Item(2).ValueHorizontalJustification = kAlignTextCenter
		oCustomTable.Columns.Item(3).ValueHorizontalJustification = kAlignTextCenter
		oCustomTable.Columns.Item(4).ValueHorizontalJustification = kAlignTextCenter
		oCustomTable.OverrideFormat = oFormat
	
	ElseIf j = 0 Then
		
		If oSheet.CustomTables.Count >0 Then
			oSheet.CustomTables.Item(1).Delete
		End If	
	End If	
Next

End Sub







Private Function Odchylka(ByVal Nor As Object, ByVal Wym As String)
'	oNorma.Add("ISO 2768-1 f(dokładna)")
'	 oNorma.Add("ISO 2768-1 m(średnia)")
'	 oNorma.Add("ISO 2768-1 c(zgrubna)")
'	 oNorma.Add("ISO 2768-1 v(bardzo zgrubna)")

If Nor = "ISO 2768-1 f(dokładna)" Then
		
	If (Wym>=0.5 And Wym<=3) Then
		Odchylka = "±" & 0.05
	ElseIf(Wym>3 And Wym<=6) Then
		Odchylka = "±" & 0.05
	ElseIf(Wym>6 And Wym<=30) Then
		Odchylka = "±" & 0.1
	ElseIf(Wym>30 And Wym<=120) Then
		Odchylka = "±" & 0.15
	ElseIf(Wym>120 And Wym<=400) Then
		Odchylka = "±" & 0.2
	ElseIf(Wym>400 And Wym<=1000) Then
		Odchylka = "±" & 0.3	
	ElseIf(Wym>1000 And Wym<=2000) Then
		Odchylka = "±" & 0.5	
	ElseIf(Wym>2000 And Wym<=4000) Then
		Odchylka = "±" & "-"
	End If


ElseIf Nor = "ISO 2768-1 m(średnia)" Then

	If (Wym>=0.5 And Wym<=3) Then
		Odchylka = "±" & 0.1
	ElseIf(Wym>3 And Wym<=6) Then
		Odchylka = "±" & 0.1
	ElseIf(Wym>6 And Wym<=30) Then
		Odchylka = "±" & 0.2
	ElseIf(Wym>30 And Wym<=120) Then
		Odchylka = "±" & 0.3
	ElseIf(Wym>120 And Wym<=400) Then
		Odchylka = "±" & 0.5
	ElseIf(Wym>400 And Wym<=1000) Then
		Odchylka = "±" & 0.8	
	ElseIf(Wym>1000 And Wym<=2000) Then
		Odchylka = "±" & 1.2	
	ElseIf(Wym>2000 And Wym<=4000) Then
		Odchylka = "±" & 2
	End If
	
ElseIf Nor = "ISO 2768-1 c(zgrubna)" Then

	If (Wym>=0.5 And Wym<=3) Then
		Odchylka = "±" & 0.2
	ElseIf(Wym>3 And Wym<=6) Then
		Odchylka = "±" & 0.3
	ElseIf(Wym>6 And Wym<=30) Then
		Odchylka = "±" & 0.5
	ElseIf(Wym>30 And Wym<=120) Then
		Odchylka = "±" & 0.8
	ElseIf(Wym>120 And Wym<=400) Then
		Odchylka = "±" & 1.2
	ElseIf(Wym>400 And Wym<=1000) Then
		Odchylka = "±" & 2	
	ElseIf(Wym>1000 And Wym<=2000) Then
		Odchylka = "±" & 3	
	ElseIf(Wym>2000 And Wym<=4000) Then
		Odchylka = "±" & 4
	End If
	
ElseIf Nor = "ISO 2768-1 v(bardzo zgrubna)" Then
	
	If (Wym>=0.5 And Wym<=3) Then
		Odchylka = "±" & "-"
	ElseIf(Wym>3 And Wym<=6) Then
		Odchylka = "±" & 0.5
	ElseIf(Wym>6 And Wym<=30) Then
		Odchylka = "±" & 1
	ElseIf(Wym>30 And Wym<=120) Then
		Odchylka = "±" & 1.5
	ElseIf(Wym>120 And Wym<=400) Then
		Odchylka = "±" & 2.5
	ElseIf(Wym>400 And Wym<=1000) Then
		Odchylka = "±" & 4	
	ElseIf(Wym>1000 And Wym<=2000) Then
		Odchylka = "±" & 6	
	ElseIf(Wym>2000 And Wym<=4000) Then
		Odchylka = "±" & 8
	End If

End If

End Function	

Private Function WNorma(ByVal Nor As Object)

'	oNorma.Add("ISO 2768-1 f(dokładna)")
'	 oNorma.Add("ISO 2768-1 m(średnia)")
'	 oNorma.Add("ISO 2768-1 c(zgrubna)")
'	 oNorma.Add("ISO 2768-1 v(bardzo zgrubna)")

If Nor = "ISO 2768-1 f(dokładna)" Then
	WNorma = "ISO 2768-1 f"
ElseIf Nor = "ISO 2768-1 m(średnia)" Then
	WNorma = "ISO 2768-1 m"	
ElseIf Nor = "ISO 2768-1 c(zgrubna)" Then
	WNorma = "ISO 2768-1 c"	
ElseIf Nor = "ISO 2768-1 v(bardzo zgrubna)" Then
	WNorma = "ISO 2768-1 v"	
End If

End Function

dusan.naus.trz · ‎10-29-2020

@l.poturala

Cześć, próbowałem i nie działa. Czy masz plik idw, który działa?

l.poturala · ‎10-30-2020

dominik_glinka · ‎06-15-2023

Dzień dobry,

próbowałem uruchomić formułę w iLogicu i pokazuje się cały czas błąd w 46 linijce - brak parametru Norma

z góry dziękuję za pomoc

benny_wellekens · ‎12-23-2023

Great, could you translate this in English? I think you will get more support if you publish this in English.
Thanks for sharing.

Tabela tolerancji w rysunku

Tabela tolerancji w rysunku

Forums Links

Submit Idea