EgtCAM5 :

- modifiche per impostazione qualità di visualizzazione superfici (con eliminazione SmoothTriMesh/ShowTriaAdv).
This commit is contained in:
Dario Sassi
2025-08-24 19:18:58 +02:00
parent cfaf513a91
commit bba92a4980
7 changed files with 146 additions and 74 deletions
+47 -6
View File
@@ -12,8 +12,8 @@ Friend Module OptionModule
Friend m_GridColor As Color3d
' Flag per visualizzazione spessa delle linee
Friend m_bThickLine As Boolean
' Flag per visualizzazione smussata delle superfici
Friend m_bSmoothTriMesh As Boolean
' Qualità di visualizzazione delle superfici
Friend m_ShowSurfQuality As SceneSurfQualityOpt
' Colore di default in disegno
Friend m_DefMaterialColor As Color3d
@@ -60,7 +60,8 @@ Friend Module OptionModule
Friend m_SelGeomWaterJetting As SceneSelModeOpt
Friend m_SelGeomFiveAxMilling As SceneSelModeOpt
Friend m_SelGeomProbing As SceneSelModeOpt
Friend m_SelVMillQuality As VMillSelTypeOpt
' Qualità di calcolo del virtual milling
Friend m_VMillQuality As VMillSelTypeOpt
' Flag per aggiungere una nuova lavorazione alla fine della fase o subito dopo la lavorazione selezionata
Friend m_bNewMachiningIsLastOne As Boolean
' Variabile che indica se usare lo script per calcolare automaticamente la disposizione quando si passa in lavorazione
@@ -111,13 +112,22 @@ Friend Module OptionModule
' Inizializzo flag linee ingrossate
m_bThickLine = (GetPrivateProfileInt(S_SCENE, K_LINEWIDTH, 1) <> 1)
' Inizializzo flag visualizzazione smussata delle superfici
m_bSmoothTriMesh = (GetPrivateProfileInt(S_SCENE, K_SHOWTRIAADV, 1) <> 0)
Dim nSSQ As Integer = GetPrivateProfileInt(S_SCENE, K_SHOWSURFQUALITY, 0)
m_ShowSurfQuality = DirectCast( Math.Min( Math.Max( nSSQ, -2), 2), SceneSurfQualityOpt)
' Inizio colore di default in disegno
Dim DefColor As New Color3d(0, 0, 0)
GetPrivateProfileColor(S_GEOMDB, K_DEFAULTCOLOR, DefColor)
m_DefMaterialColor = DefColor
' Inizializzo tolleranza geometrica
m_dGeometryTolerance = GetPrivateProfileDouble(S_GEOMDB, K_SURFTMTOLER, 0.05)
' Inizializzo stile corrente delle quotature
m_dExtLineLen = GetPrivateProfileDouble(S_DIMENSIONSTYLE, K_EXTLINELEN, 5)
m_dArrowLen = GetPrivateProfileDouble(S_DIMENSIONSTYLE, K_ARROWLEN, 5)
m_dTextDist = GetPrivateProfileDouble(S_DIMENSIONSTYLE, K_TEXTDIST, 2)
m_nLenIsMM = GetPrivateProfileInt(S_DIMENSIONSTYLE, K_LENISMM, 2)
m_nDecDigit = GetPrivateProfileInt(S_DIMENSIONSTYLE, K_DECDIGIT, -2)
m_sFont = "" : GetPrivateProfileStringUtf8(S_DIMENSIONSTYLE, K_DIMFONT, "ModernPropS.Nfe", m_sFont)
m_dTextHeight = GetPrivateProfileDouble(S_DIMENSIONSTYLE, K_TEXTHEIGHT, 2)
' Inizializzo variabili per import
m_dDxfScaleFactor = GetPrivateProfileDouble(S_IMPORT, K_DXFSCALE, 1)
m_dStlScaleFactor = GetPrivateProfileDouble(S_IMPORT, K_STLSCALE, 1)
@@ -157,9 +167,10 @@ Friend Module OptionModule
m_SelGeomFiveAxMilling = If(Temp < 0 Or Temp > 3, SceneSelModeOpt.PARTCURVESANDSURFACES, DirectCast(Temp, SceneSelModeOpt))
Temp = GetPrivateProfileInt(S_MACH, K_SELGEOMPROBING, -1)
m_SelGeomProbing = If(Temp < 0 Or Temp > 3, SceneSelModeOpt.PARTCURVESANDSURFACES, DirectCast(Temp, SceneSelModeOpt))
Temp = GetPrivateProfileInt(S_MACH, K_SELVMILLQUALITY, 0)
m_SelVMillQuality = If(Temp < -2 Or Temp > 2, VMillSelTypeOpt.HIGHER, DirectCast(Temp, VMillSelTypeOpt))
m_SelGeomWaterJetting = SceneSelModeOpt.PARTCURVES
' Inizializzo qualità di virtual milling
Temp = GetPrivateProfileInt(S_MACH, K_VMILLQUALITY, 0)
m_VMillQuality = DirectCast(Math.Min( Math.Max( Temp, -2), 2), VMillSelTypeOpt)
' Inizializzo variabile che indica posizione nuova operazione di lavorazione
m_bNewMachiningIsLastOne = (GetPrivateProfileInt(S_OPTIONS, K_NEWMACHININGISLASTONE, 0) <> 0)
' Inizializzo variabile che indica se usare script di disposizione
@@ -172,6 +183,36 @@ Friend Module OptionModule
m_bGunstockOn = (GetPrivateProfileInt(S_GUNSTOCK, K_GUNSTOCKENABLE, 0) <> 0)
End Sub
' restituisco spessore linee
Friend Function GetLineWidth() As Integer
Return If( m_bThickLine, 2, 1)
End Function
' imposto stato visualizzazione superfici
Friend Sub SetShowSurfQuality( bRedraw As Boolean)
Dim bSmoothTriMesh As Boolean = True
Dim dSrfBezShowTol As Double = 0.2
Select m_ShowSurfQuality
Case SceneSurfQualityOpt.LOWER
bSmoothTriMesh = False
dSrfBezShowTol = 4
Case SceneSurfQualityOpt.LOW
bSmoothTriMesh = False
dSrfBezShowTol = 1
Case SceneSurfQualityOpt.STANDARD
bSmoothTriMesh = True
dSrfBezShowTol = 0.2
Case SceneSurfQualityOpt.HIGH
bSmoothTriMesh = True
dSrfBezShowTol = 0.05
Case SceneSurfQualityOpt.HIGHER
bSmoothTriMesh = True
dSrfBezShowTol = 0.01
End Select
EgtSetShowTriaAdv(bSmoothTriMesh, false)
EgtSetShowSurfBezierTol(dSrfBezShowTol, bRedraw)
End Sub
End Module
' Classe che identifica una lingua del programma con nome e path del file dei messaggi