Dario Sassi
b1b4fe5c42
- riordinato direttorio con cartelle - sistemazioni varie per lucidature e svuotature.
381 lines
16 KiB
VB.net
381 lines
16 KiB
VB.net
Imports EgtUILib
|
|
|
|
Module SideAngle
|
|
|
|
Private m_MainWindow As MainWindow = DirectCast(Application.Current.MainWindow, MainWindow)
|
|
|
|
|
|
Friend Sub WriteSideAngleForNest(nCtx As Integer)
|
|
' Imposto contesto corrente
|
|
EgtSetCurrentContext(nCtx)
|
|
Dim PartId As Integer = EgtGetFirstPart()
|
|
While PartId <> GDB_ID.NULL
|
|
' Se richiesti lati paralleli con misura sul top come in TRF, verifico e aggiusto
|
|
If GetPrivateProfileInt( S_SIDES, K_PARSIDE_AS_TRF, 0, m_MainWindow.GetIniFile()) <> 0 Then
|
|
AdjustAsTrfParSides( PartId)
|
|
End If
|
|
' Elimino eventuale precedente layer per testi
|
|
EgtErase(EgtGetFirstNameInGroup(PartId, SIDE_ANGLE_LAYER))
|
|
' Creo layer per testi nesting
|
|
Dim TextLayId As Integer = EgtCreateGroup(PartId)
|
|
EgtSetName(TextLayId, SIDE_ANGLE_LAYER)
|
|
EgtSetColor(TextLayId, New Color3d(0, 0, 128))
|
|
' Opero su geometria esterna pezzo
|
|
WriteSideAngleOnLoop(EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP), TextLayId)
|
|
' Ciclo su geometria interna pezzo
|
|
Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_INLOOP)
|
|
While LoopId <> GDB_ID.NULL
|
|
WriteSideAngleOnLoop(LoopId, TextLayId)
|
|
LoopId = EgtGetNextName(LoopId, NAME_INLOOP)
|
|
End While
|
|
PartId = EgtGetNextPart(PartId)
|
|
End While
|
|
End Sub
|
|
|
|
' Funzione che verifica se la linea corrente è inclinabile in base al tipo della precedente e successiva
|
|
Friend Function VerifyIsSideAnglePossible(LastLine As Integer, CurrLine As Integer, NextLine As Integer, bOutLoop As Boolean) As Boolean
|
|
' Analisi del tipo
|
|
Select EgtGetType(CurrLine)
|
|
Case GDB_TY.CRV_LINE
|
|
' Le linee vanno bene di per sè
|
|
Case GDB_TY.CRV_ARC
|
|
' Gli archi devono essere lavorati sul lato esterno
|
|
Dim dAngCen As Double : EgtArcAngCenter( CurrLine, dAngCen)
|
|
If ( bOutLoop And dAngCen < 0) Or ( Not bOutLoop And dAngCen > 0) Then Return False
|
|
Case GDB_TY.CRV_COMPO
|
|
' Gli archi componenti devono essere lavorati sul lato esterno
|
|
Dim nCopyId As Integer = EgtCopy( CurrLine, CurrLine, GDB_POS.AFTER)
|
|
If nCopyId = GDB_ID.NULL Then Return False
|
|
Dim bOk As Boolean = True
|
|
Dim nCount As Integer = 0
|
|
Dim nNewId As Integer = EgtExplodeCurveCompo( nCopyId, nCount)
|
|
For nI As Integer = 0 To nCount - 1
|
|
Dim nEntId As Integer = nNewId + nI
|
|
If EgtGetType( nEntId) = GDB_TY.CRV_ARC Then
|
|
Dim dAngCen As Double : EgtArcAngCenter( nEntId, dAngCen)
|
|
If ( bOutLoop And dAngCen < 0) Or ( Not bOutLoop And dAngCen > 0) Then bOk = False
|
|
End If
|
|
EgtErase( nEntId)
|
|
Next
|
|
If Not bOk Then Return False
|
|
Case Else
|
|
Return False
|
|
End Select
|
|
|
|
' Se curva chiusa va bene solo se loop esterno
|
|
if EgtCurveIsClosed( CurrLine) Then Return bOutLoop
|
|
|
|
' Delta angolare limite per tangenza
|
|
Const DELTA_ANG_TG As Double = 5.0
|
|
' Verifico se curva precedente mi permette di inclinare
|
|
Dim bLastOk As Boolean = False
|
|
Select EgtGetType(LastLine)
|
|
Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_COMPO
|
|
' Ricavo direzione finale curva precedente
|
|
Dim vtLastEnd As Vector3d
|
|
EgtEndVector(LastLine, vtLastEnd)
|
|
' Ricavo direzione iniziale curva corrente
|
|
Dim vtCurrStart As Vector3d
|
|
EgtStartVector(CurrLine, vtCurrStart)
|
|
' Confronto direzioni per vedere se sono tangenti
|
|
Dim dAngDeg As Double = GetAngle( vtLastEnd, vtCurrStart)
|
|
' verifico se l'angolo è significativo
|
|
bLastOk = ( dAngDeg > DELTA_ANG_TG)
|
|
Case Else
|
|
EgtOutLog("Error in Compo Outloop: found an entity that is not a line or a arc")
|
|
End Select
|
|
|
|
' Verifico se curva successiva mi permette di inclinare
|
|
Dim bNextOk As Boolean = False
|
|
Select EgtGetType(NextLine)
|
|
Case GDB_TY.CRV_LINE, GDB_TY.CRV_ARC, GDB_TY.CRV_COMPO
|
|
' Ricavo direzione finale curva corrente
|
|
Dim vtCurrEnd As Vector3d
|
|
EgtEndVector(CurrLine, vtCurrEnd)
|
|
' Ricavo direzione iniziale curva successiva
|
|
Dim vtNextStart As Vector3d
|
|
EgtStartVector(NextLine, vtNextStart)
|
|
' Confronto direzioni per vedere se sono tangenti
|
|
Dim dAngDeg As Double = GetAngle( vtCurrEnd, vtNextStart)
|
|
' verifico se l'angolo è significativo
|
|
bNextOk = ( dAngDeg > DELTA_ANG_TG)
|
|
Case Else
|
|
EgtOutLog("Error in Compo Outloop: found an entity that is not a line or a arc")
|
|
End Select
|
|
|
|
' Se entrambe me lo permettono restituisco vero
|
|
Return ( bLastOk And bNextOk)
|
|
End Function
|
|
|
|
Private Function AdjustAsTrfParSides( PartId As Integer) As Boolean
|
|
' Recupero il loop esterno
|
|
Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP)
|
|
If LoopId = GDB_ID.NULL Then Return False
|
|
' Scansiono i lati
|
|
Dim LineId As Integer = EgtGetFirstInGroup(LoopId)
|
|
While LineId <> GDB_ID.NULL
|
|
' Se non è linea con singolo angolo, vado oltre
|
|
If Not EgtExistsInfo(LineId, INFO_SIDE_ANGLE) OrElse
|
|
EgtExistsInfo(LineId, INFO_SIDE_ANGLE2) OrElse
|
|
EgtExistsInfo(LineId, INFO_HEEL) Then
|
|
LineId = EgtGetNext(LineId)
|
|
Continue While
|
|
End If
|
|
' Recupero angolo di fianco e direzione
|
|
Dim dSideAng As Double = 0 : EgtGetInfo( LineId, INFO_SIDE_ANGLE, dSideAng)
|
|
Dim vtDir As new Vector3d : EgtStartVector( LineId, GDB_ID.ROOT, vtDir)
|
|
' Confronto con le linee successive
|
|
Dim OthLId As Integer = EgtGetNext(LineId)
|
|
While OthLId <> GDB_ID.NULL
|
|
' Se non è linea con singolo angolo, vado oltre
|
|
If Not EgtExistsInfo(OthLId, INFO_SIDE_ANGLE) OrElse
|
|
EgtExistsInfo(OthLId, INFO_SIDE_ANGLE2) OrElse
|
|
EgtExistsInfo(OthLId, INFO_HEEL) Then
|
|
OthLId = EgtGetNext(OthLId)
|
|
Continue While
|
|
End If
|
|
' Recupero angolo di fianco e direzione
|
|
Dim dOthSAng As Double = 0 : EgtGetInfo( OthLId, INFO_SIDE_ANGLE, dOthSAng)
|
|
Dim vtOthDir As new Vector3d : EgtStartVector( OthLId, GDB_ID.ROOT, vtOthDir)
|
|
' Se gli angoli sono opposti e le due linee sono controverse
|
|
If Math.Abs( dSideAng + dOthSAng) < 10 * EPS_ANG_SMALL AndAlso (vtDir + vtOthDir).IsSmall() Then
|
|
EgtSetInfo( LineId, INFO_SIDE_FIXED, 1)
|
|
EgtSetInfo( OthLId, INFO_SIDE_FIXED, 1)
|
|
Exit While
|
|
End If
|
|
OthLId = EgtGetNext(OthLId)
|
|
End While
|
|
LineId = EgtGetNext(LineId)
|
|
End While
|
|
Return True
|
|
End Function
|
|
|
|
Private Function WriteSideAngleOnLoop(LoopId As Integer, TextLayId As Integer) As Boolean
|
|
' Verifiche
|
|
If LoopId = GDB_ID.NULL Or TextLayId = GDB_ID.NULL Then Return False
|
|
' Calcolo dimensione ingombro Loop
|
|
Dim ptMin, ptMax As Point3d
|
|
EgtGetBBoxGlob(LoopId, GDB_BB.STANDARD, ptMin, ptMax)
|
|
Dim dBBoxRad As Double = 0.5 * Point3d.DistXY(ptMin, ptMax)
|
|
' Ciclo sulle curve di contorno, se hanno info con inclinazione aggiungo testo con angolo
|
|
Dim LineId As Integer = EgtGetFirstInGroup(LoopId)
|
|
While LineId <> GDB_ID.NULL
|
|
Dim dSideAngle As Double = 0
|
|
Dim bSA As Boolean = EgtGetInfo(LineId, INFO_SIDE_ANGLE, dSideAngle)
|
|
Dim dSideAngle2 As Double = 0
|
|
Dim bSA2 As Boolean = EgtGetInfo(LineId, INFO_SIDE_ANGLE2, dSideAngle2)
|
|
Dim dSideHeel As Double = 0
|
|
Dim bSH As Boolean = EgtGetInfo(LineId, INFO_HEEL, dSideHeel)
|
|
If Math.Abs(dSideAngle) > EPS_ANG_SMALL Or ( bSA2 And Not bSH) Then
|
|
' Creo testo con angolo di inclinazione
|
|
Dim sText As String = DoubleToString(dSideAngle, 2) & "°"
|
|
' Se presente tallone, lo indico
|
|
If bSH then
|
|
If dSideHeel > 10 * EPS_SMALL Then
|
|
If dSideAngle > 0 Then
|
|
sText = sText & "; " & LenToString(dSideHeel, 2)
|
|
Else
|
|
sText = LenToString(dSideHeel, 2) & "; " & sText
|
|
End If
|
|
End If
|
|
' se altrimenti presente secondo angolo, lo indico
|
|
ElseIf bSA2 then
|
|
sText = DoubleToString(dSideAngle2, 2) & "°" & "; " & sText
|
|
End If
|
|
AddTextToLine(sText, TextLayId, LineId, 15, dBBoxRad, False, True)
|
|
End If
|
|
LineId = EgtGetNext(LineId)
|
|
End While
|
|
Return True
|
|
End Function
|
|
|
|
Friend Sub ColorToSideAngle(nCtx As Integer)
|
|
' Leggo dati corrispondenza colore-angolo
|
|
Dim CurrCSA As New ColorSideAngs
|
|
CurrCSA.Read( m_MainWindow.GetIniFile)
|
|
' Imposto contesto corrente
|
|
EgtSetCurrentContext(nCtx)
|
|
' Ciclo sui pezzi
|
|
Dim PartId As Integer = EgtGetFirstPart()
|
|
While PartId <> GDB_ID.NULL
|
|
' Ciclo sui layer di contorno
|
|
Dim bOutLoop As Boolean = True
|
|
Dim LoopId As Integer = EgtGetFirstNameInGroup(PartId, NAME_OUTLOOP)
|
|
While LoopId <> GDB_ID.NULL
|
|
' Ciclo sulle curve
|
|
Dim PrevId As Integer = EgtGetLastInGroup( LoopId)
|
|
Dim EntId As Integer = EgtGetFirstInGroup( LoopId)
|
|
While EntId <> GDB_ID.NULL
|
|
Dim NextId As Integer = EgtGetNext( EntId)
|
|
If NextId = GDB_ID.NULL Then NextId = EgtGetFirstInGroup( LoopId)
|
|
If VerifyIsSideAnglePossible( PrevId, EntId, NextId, bOutLoop) Then
|
|
Dim colEnt As Color3d
|
|
If EgtGetColor( EntId, colEnt) Then
|
|
Dim dAng As Double
|
|
Dim dHeel As Double
|
|
If CurrCSA.GetSideAngHeel( colEnt, dAng, dHeel) Then
|
|
EgtSetInfo( EntId, INFO_SIDE_ANGLE, dAng)
|
|
EgtSetInfo( EntId, INFO_ORIG_SIDE_ANGLE, dAng)
|
|
EgtSetInfo( EntId, INFO_HEEL, dHeel)
|
|
End If
|
|
End If
|
|
End If
|
|
PrevId = EntId
|
|
EntId = EgtGetNext( EntId)
|
|
End While
|
|
If bOutLoop then
|
|
bOutLoop = False
|
|
LoopId = EgtGetFirstNameInGroup(PartId, NAME_INLOOP)
|
|
Else
|
|
LoopId = EgtGetNextName(LoopId, NAME_INLOOP)
|
|
End If
|
|
End While
|
|
PartId = EgtGetNextPart(PartId)
|
|
End While
|
|
' Aggiorno scritte per angoli sui lati
|
|
WriteSideAngleForNest(nCtx)
|
|
End Sub
|
|
|
|
' Funzione che dato un segmento e una distanza, scrive il testo centrato alla sua sinistra (destra se bTextExt)
|
|
Friend Function AddTextToLine(sText As String, TextLayer As Integer, CurrLine As Integer, dDistance As Double,
|
|
dBBoxRad As Double, bTextExt As Boolean, Optional bRot As Boolean = False) As Integer
|
|
' Calcolo altezza testo
|
|
Dim dH As Double = 0.05 * dBBoxRad
|
|
' Creo testo
|
|
Dim nText As Integer = EgtCreateTextAdv(TextLayer, Point3d.ORIG(), 0, sText, "", 500, False, dH, 1, 0, INS_POS.MC)
|
|
' Calcolo posizionamento
|
|
' BBox del testo e suo centro
|
|
Dim ptMinBBox As Point3d
|
|
Dim ptMaxBBox As Point3d
|
|
EgtGetBBox(nText, GDB_BB.STANDARD, ptMinBBox, ptMaxBBox)
|
|
Dim ptMidBBox As Point3d
|
|
ptMidBBox = Point3d.Media(ptMinBBox, ptMaxBBox)
|
|
' Punto medio della curva
|
|
Dim ptMid As Point3d
|
|
EgtMidPoint( CurrLine, nText, ptMid)
|
|
' Versore sul punto medio della curva
|
|
Dim vtMid As Vector3d
|
|
EgtMidVector( CurrLine, nText, vtMid)
|
|
' versore perpendicolare alla CurrLine che punta verso il testo
|
|
Dim vtOrto As New Vector3d( vtMid)
|
|
If bTextExt Then
|
|
vtOrto.Rotate( Vector3d.Z_AX(), -90)
|
|
Else
|
|
vtOrto.Rotate( Vector3d.Z_AX(), 90)
|
|
End If
|
|
' eventuale rotazione del testo
|
|
Dim dRotAng As Double = 0
|
|
If bRot Then
|
|
dRotAng = Math.Atan2( vtMid.y, vtMid.x) * 180 / Math.PI
|
|
Dim dSpecRotAng = dRotAng
|
|
If dSpecRotAng > 91 Then
|
|
dSpecRotAng -= 180
|
|
ElseIf dSpecRotAng < -89 Then
|
|
dSpecRotAng += 180
|
|
End If
|
|
EgtRotate(nText, Point3d.ORIG(), Vector3d.Z_AX(), dSpecRotAng)
|
|
End If
|
|
' vettore dal centro del BBox all'estremo più vicino
|
|
Dim vtptExtptMC As Vector3d
|
|
If bRot Then
|
|
vtptExtptMC = New Vector3d(0, ptMidBBox.y - ptMinBBox.y, 0)
|
|
vtptExtptMC.Rotate(Vector3d.Z_AX(), dRotAng)
|
|
Else
|
|
If bTextExt Then
|
|
If vtMid.x > 0 Then
|
|
If vtMid.y > 0 Then
|
|
vtptExtptMC = ptMidBBox - New Point3d(ptMinBBox.x, ptMaxBBox.y, 0)
|
|
Else
|
|
vtptExtptMC = ptMidBBox - ptMaxBBox
|
|
End If
|
|
Else
|
|
If vtMid.y > 0 Then
|
|
vtptExtptMC = ptMidBBox - ptMinBBox
|
|
Else
|
|
vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0)
|
|
End If
|
|
End If
|
|
Else
|
|
If vtMid.x > 0 Then
|
|
If vtMid.y > 0 Then
|
|
vtptExtptMC = ptMidBBox - New Point3d(ptMaxBBox.x, ptMinBBox.y, 0)
|
|
Else
|
|
vtptExtptMC = ptMidBBox - ptMinBBox
|
|
End If
|
|
Else
|
|
If vtMid.y > 0 Then
|
|
vtptExtptMC = ptMidBBox - ptMaxBBox
|
|
Else
|
|
vtptExtptMC = ptMidBBox - New Point3d(ptMinBBox.x, ptMaxBBox.y, 0)
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
' Calcolo il centro del testo
|
|
Dim ptTextMC As Point3d = ptMid + vtOrto * (dDistance + (vtOrto * vtptExtptMC))
|
|
EgtMove(nText, (ptTextMC - Point3d.ORIG()))
|
|
Return nText
|
|
End Function
|
|
|
|
'--------------------------------------------------------------------------------------------------
|
|
Friend Class ColorSideAngs
|
|
Class CTSA
|
|
Friend m_bOk As Boolean
|
|
Friend m_R As Integer
|
|
Friend m_G As Integer
|
|
Friend m_B As Integer
|
|
Friend m_dAng As Double
|
|
Friend m_dHeel As Double
|
|
End Class
|
|
Private m_ListCtsa As New List(Of CTSA)
|
|
Private m_nTol As Integer = 10
|
|
|
|
Friend Function Read( sIniFile As String) As Boolean
|
|
' Lettura parametri di conversione
|
|
Dim nIndex As Integer = 1
|
|
Dim OneCtsa As CTSA = GetPrivateProfileColorSideAng( S_COLORTOSIDEANG, K_CTSA & nIndex, sIniFile)
|
|
While Not IsNothing(OneCtsa)
|
|
m_ListCtsa.Add(OneCtsa)
|
|
nIndex += 1
|
|
OneCtsa = GetPrivateProfileColorSideAng( S_COLORTOSIDEANG, K_CTSA & nIndex, sIniFile)
|
|
End While
|
|
' Lettura tolleranza
|
|
m_nTol = GetPrivateProfileInt( S_COLORTOSIDEANG, K_CTSA_TOLERANCE, 10, sIniFile)
|
|
Return True
|
|
End Function
|
|
|
|
Private Function GetPrivateProfileColorSideAng( sSect As String, sKey As String, sIniFile As String) As CTSA
|
|
Dim OneCtsa As New CTSA
|
|
Dim sVal As String = String.Empty
|
|
GetPrivateProfileString(sSect, sKey, "", sVal, sIniFile)
|
|
Dim sItems() As String = sVal.Split(",".ToCharArray)
|
|
OneCtsa.m_bOk = If( sItems.Count() = 6, ( sItems(5).Trim() <> "0"), True)
|
|
If sItems.Count() >= 5 Then
|
|
StringToInt( sItems(0), OneCtsa.m_R)
|
|
StringToInt( sItems(1), OneCtsa.m_G)
|
|
StringToInt( sItems(2), OneCtsa.m_B)
|
|
StringToDouble( sItems(3), OneCtsa.m_dAng)
|
|
StringToDouble( sItems(4), OneCtsa.m_dHeel)
|
|
Return OneCtsa
|
|
End If
|
|
Return Nothing
|
|
End Function
|
|
|
|
Friend Function GetSideAngHeel( cCol As Color3d, ByRef dAng As Double, ByRef dHeel As Double) As Boolean
|
|
For Each Ctsa In m_ListCtsa
|
|
If Ctsa.m_bOk And
|
|
Math.Abs( cCol.R - Ctsa.m_R) < m_nTol And
|
|
Math.Abs( cCol.G - Ctsa.m_G) < m_nTol And
|
|
Math.Abs( cCol.B - Ctsa.m_B) < m_nTol Then
|
|
dAng = Ctsa.m_dAng
|
|
dHeel = Ctsa.m_dHeel
|
|
Return True
|
|
End If
|
|
Next
|
|
Return False
|
|
End Function
|
|
|
|
End Class
|
|
|
|
End Module
|