Files
Nicola Pievani 98b6563e57 OmagVIEWPlus 2.2k1:
-> verificate coordinate di prelievo e deposito (Tab1 e Tab2)
-> scatta foto
-> gestione di preparazione pallet (nesting 1d)
-> gestione mancato vuoto su tavola 1
-> gestione di mancato vuoto tavola 2.
2020-11-20 19:48:51 +00:00

578 lines
25 KiB
VB.net

'----------------------------------------------------------------------------
' EgalTech 2015-2017
'----------------------------------------------------------------------------
' File : GenPhoto.vb Data : 12.04.17 Versione : 1.8d1
' Contenuto : Modulo gestione fotografie.
' Ogni gruppo di lavoro può avere una sua foto della lastra.
'
'
' Modifiche : 12.04.17 DS Creazione modulo.
'
'
'----------------------------------------------------------------------------
Imports System.IO
Imports EgtUILib
Imports EgtWPFLib5
Module EstPhoto
' Offset aggiuntivi per fotografia
Private m_dPhotoOffsetX As Double = 0
Private m_dPhotoOffsetY As Double = 0
Private m_dTab2PhotoOffsetX As Double = 0
Private m_dTab2PhotoOffsetY As Double = 0
' spessore pezzi
'Private m_dRawHeight As Double = 80
Friend ReadOnly Property PhotoOffset As Vector3d
Get
Select Case GetCurrentTable()
Case 2
Return New Vector3d(m_dTab2PhotoOffsetX, m_dTab2PhotoOffsetY, 0)
Case Else
Return New Vector3d(m_dPhotoOffsetX, m_dPhotoOffsetY, 0)
End Select
End Get
End Property
Friend Function LoadPhoto(sPath As String) As Boolean
' Verifico esistenza file immagine
If Not File.Exists(sPath) Then Return False
' Leggo eventuale file dati aggiuntivi
Dim ptOri As New Point3d(0, 0, 0)
Dim ptCen As New Point3d(0, 0, INFINITO)
Dim dMMxPixel As Double = 1
ReadAuxData(sPath, ptOri, ptCen, dMMxPixel)
' Aggiungo eventuali offset
ptOri += PhotoOffset
ptCen += PhotoOffset
' Altezza eventuale tavola aggiuntiva
'Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
' Aggiusto dati per spessore grezzo
If Math.Abs(EstCalc.GetRawHeight()) > EPS_SMALL Then
' Coefficiente di scalatura
Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight()) / (ptCen.z - ptOri.z)
dMMxPixel *= dFsca
ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca
ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca
ptOri.z = EstCalc.GetRawHeight() + 0.05
End If
' Recupero origine della tavola e porto i punti in globale
Dim ptTab As Point3d
If Not EgtGetTableRef(1, ptTab) Then Return False
ptOri.ToGlob(New Frame3d(ptTab))
ptCen.ToGlob(New Frame3d(ptTab))
' Recupero le dimensioni della tavola
Dim ptMin, ptMax As Point3d
If Not EgtGetTableArea(1, ptMin, ptMax) Then Return False
' Elimino eventuale precedente foto
Dim nOldPhotoId = GetPhoto()
If nOldPhotoId <> GDB_ID.NULL Then EgtErase(nOldPhotoId)
' Se non esiste il gruppo per le foto, lo creo
Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)
If nPhGrpId = GDB_ID.NULL Then
nPhGrpId = EgtCreateGroup(GDB_ID.ROOT)
If nPhGrpId = GDB_ID.NULL Then Return False
EgtSetName(nPhGrpId, PHOTO_GRP)
End If
EgtSetLevel(nPhGrpId, GDB_LV.SYSTEM)
' Carico la fotografia
Return EgtAddPhoto(PHOTO_NAME, sPath, ptOri, ptCen, dMMxPixel, nPhGrpId, ptMin, ptMax) <> GDB_ID.NULL
End Function
Friend Function LoadContour(sPath As String) As Boolean
' Elimino eventuale vecchio contorno
RemoveContour()
' Verifico esistenza file contorno
If Not File.Exists(sPath) Then Return False
' Leggo eventuale file dati aggiuntivi
Dim ptOri As New Point3d(0, 0, 0)
Dim ptCen As New Point3d(0, 0, INFINITO)
Dim dMMxPixel As Double = 1
ReadAuxData(sPath, ptOri, ptCen, dMMxPixel)
' Aggiungo eventuali offset
ptOri += PhotoOffset
ptCen += PhotoOffset
' Recupero dimensione della immagine da cui è stata derivata la fotografia
Dim nPixelX As Integer = 0
Dim nPixelY As Integer = 0
If Not EgtGetPhotoImagePixels(GetPhoto(), nPixelX, nPixelY) Then Return False
' Altezza eventuale tavola aggiuntiva
'Dim dAddTable As Double = m_MainWindow.m_CurrentMachine.dAdditionalTable
' Aggiusto dati per spessore grezzo
If Math.Abs(EstCalc.GetRawHeight()) > EPS_SMALL Then
' Coefficiente di scalatura
Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight()) / (ptCen.z - ptOri.z)
dMMxPixel *= dFsca
ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca
ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca
ptOri.z = EstCalc.GetRawHeight()
End If
' Recupero origine della tavola e porto i punti in globale
Dim ptTab As Point3d
If Not EgtGetTableRef(1, ptTab) Then Return False
ptOri.ToGlob(New Frame3d(ptTab))
ptCen.ToGlob(New Frame3d(ptTab))
' Carico Dxf del contorno
If Not EgtImportDxf(sPath, 1) Then Return False
Dim nPartId As Integer = EgtGetLastPart()
Dim nLayerId As Integer = EgtGetFirstLayer(nPartId)
EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE)
EgtSetLevel(nPartId, GDB_LV.SYSTEM)
EgtSetColor(nPartId, New Color3d(0, 255, 0))
If nPartId = GDB_ID.NULL Or nLayerId = GDB_ID.NULL Then Return False
' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW)
EgtMirror(nLayerId, New Point3d(0, nPixelY / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB)
' Eseguo scalatura
EgtScale(nLayerId, New Frame3d(), dMMxPixel, dMMxPixel, dMMxPixel, GDB_RT.GLOB)
' Eseguo spostamento
EgtMove(nLayerId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB)
' Eseguo concatenamento
EgtSelectGroupObjs(nLayerId)
EgtCreateCurveCompoByReorder(nLayerId, 1, {GDB_ID.SEL}, New Point3d(), True)
' Conservo la curva chiusa di area massima
Dim dAreaMax As Double = 0
Dim nCrvId As Integer = GDB_ID.NULL
Dim nCurrCrvId As Integer = EgtGetFirstInGroup(nLayerId)
While nCurrCrvId <> GDB_ID.NULL
Dim dArea As Double = 0
If Not EgtCurveAreaXY(nCurrCrvId, dArea) OrElse dArea <= dAreaMax Then
Dim nToEraseId = nCurrCrvId
nCurrCrvId = EgtGetNext(nCurrCrvId)
EgtErase(nToEraseId)
Else
dAreaMax = dArea
EgtErase(nCrvId)
nCrvId = nCurrCrvId
nCurrCrvId = EgtGetNext(nCurrCrvId)
End If
End While
If nCrvId = GDB_ID.NULL Then Return False
' Eseguo le semplificazioni
Dim nApprType As Integer = APP_TYPE.RIGHT_LINES
Dim dTol As Double = Map.refMainWindowVM.m_Camera.Tolerance
EgtApproxCurve(nCrvId, nApprType, dTol)
Dim ptNew As Point3d
EgtMidPoint(nCrvId, ptNew)
EgtChangeClosedCurveStartPoint(nCrvId, ptNew)
EgtApproxCurve(nCrvId, nApprType, dTol)
Return True
End Function
'Private Function LoadStandardContour(sPath As String, ptOri As Point3d, dMMxPixel As Double, nPixelY As Integer, dCoeff As Double) As Integer
' ' Carico Dxf del contorno
' If Not EgtImportDxf(sPath, 1) Then Return GDB_ID.NULL
' Dim nPartId As Integer = EgtGetLastPart()
' Dim nLayerId As Integer = EgtGetFirstLayer(nPartId)
' EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE)
' EgtSetLevel(nPartId, GDB_LV.SYSTEM)
' If nPartId = GDB_ID.NULL Or nLayerId = GDB_ID.NULL Then Return GDB_ID.NULL
' ' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW)
' EgtMirror(nLayerId, New Point3d(0, nPixelY * dCoeff / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB)
' ' Eseguo scalatura
' Dim dScaCoeff As Double = dMMxPixel / dCoeff
' EgtScale(nLayerId, New Frame3d(), dScaCoeff, dScaCoeff, dScaCoeff, GDB_RT.GLOB)
' ' Eseguo spostamento
' EgtMove(nLayerId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB)
' ' Eseguo concatenamento
' EgtSelectGroupObjs(nLayerId)
' EgtCreateCurveCompoByReorder(nLayerId, 1, {GDB_ID.SEL}, New Point3d(), True)
' ' Conservo la curva chiusa di area massima
' Dim dAreaMax As Double = 0
' Dim nCrvId As Integer = GDB_ID.NULL
' Dim nCurrCrvId As Integer = EgtGetFirstInGroup(nLayerId)
' While nCurrCrvId <> GDB_ID.NULL
' Dim dArea As Double = 0
' If Not EgtCurveAreaXY(nCurrCrvId, dArea) OrElse dArea <= dAreaMax Then
' Dim nToEraseId = nCurrCrvId
' nCurrCrvId = EgtGetNext(nCurrCrvId)
' EgtErase(nToEraseId)
' Else
' dAreaMax = dArea
' EgtErase(nCrvId)
' nCrvId = nCurrCrvId
' nCurrCrvId = EgtGetNext(nCurrCrvId)
' End If
' End While
' EgtSetColor(nCrvId, New Color3d(0, 255, 0))
' Return nCrvId
'End Function
'Private Function LoadCustomContour(sPath As String, ptOri As Point3d, dMMxPixel As Double, nPixelY As Integer, dCoeff As Double) As Integer
' ' Definizione variabili
' EgtLuaCreateGlobTable("RCT")
' EgtLuaSetGlobStringVar("RCT.FILE", sPath)
' ' Esecuzione
' Dim nErr As Integer = 999
' If EgtLuaExecFile(OmagOFFICEMap.refMainWindowVM.MainWindowM.sImgAutoDir & "\ReadContour.lua") AndAlso
' EgtLuaCallFunction("RCT.ReadContour") Then
' ' Verifica stato di errore
' EgtLuaGetGlobIntVar("RCT.ERR", nErr)
' End If
' If nErr <> 0 Then
' EgtOutLog("Error in ReadContour : " & nErr.ToString())
' Return GDB_ID.NULL
' End If
' ' Leggo i risultati
' Dim nPartId As Integer = GDB_ID.NULL
' EgtLuaGetGlobIntVar("RCT.PARTID", nPartId)
' If nPartId = GDB_ID.NULL Then Return GDB_ID.NULL
' EgtSetName(nPartId, NAME_RAW_PHOTO_OUTLINE)
' EgtSetLevel(nPartId, GDB_LV.SYSTEM)
' Dim nCrvId As Integer = GDB_ID.NULL
' EgtLuaGetGlobIntVar("RCT.CRVID", nCrvId)
' EgtLuaResetGlobVar("RCT")
' If nCrvId = GDB_ID.NULL Then Return GDB_ID.NULL
' EgtSetColor(nCrvId, New Color3d(0, 255, 0))
' ' Ribalto rispetto a YZ locale (i contorni da CW diventano CCW)
' EgtMirror(nCrvId, New Point3d(0, nPixelY * dCoeff / 2, 0), Vector3d.Y_AX(), GDB_RT.GLOB)
' ' Eseguo scalatura
' Dim dScaCoeff As Double = dMMxPixel / dCoeff
' EgtScale(nCrvId, New Frame3d(), dScaCoeff, dScaCoeff, dScaCoeff, GDB_RT.GLOB)
' ' Eseguo spostamento
' EgtMove(nCrvId, (ptOri - Point3d.ORIG()), GDB_RT.GLOB)
' ' Deve essere CCW
' Dim dArea As Double = 0
' If EgtCurveAreaXY(nCrvId, dArea) AndAlso dArea < 0 Then
' EgtInvertCurve(nCrvId)
' End If
' Return nCrvId
'End Function
Private Function ReadAuxData(sPath As String,
ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double) As Boolean
Dim sAuxPath As String = Path.ChangeExtension(sPath, ".txt")
Try
Dim sLine As String = String.Empty
Dim sr As StreamReader = New StreamReader(sAuxPath)
Do While sr.Peek() > -1
sLine = sr.ReadLine()
sLine = sLine.Replace(" ", "")
If sLine.StartsWith("X=") Then
StringToDouble(sLine.Substring(2), ptOri.x)
ElseIf sLine.StartsWith("Y=") Then
StringToDouble(sLine.Substring(2), ptOri.y)
ElseIf sLine.StartsWith("Z_Lastra=") Then
StringToDouble(sLine.Substring(9), ptOri.z)
ElseIf sLine.StartsWith("X_ScaleCenter=") Then
StringToDouble(sLine.Substring(14), ptCen.x)
ElseIf sLine.StartsWith("Y_ScaleCenter=") Then
StringToDouble(sLine.Substring(14), ptCen.y)
ElseIf sLine.StartsWith("Z_ScaleCenter=") Then
StringToDouble(sLine.Substring(14), ptCen.z)
ElseIf sLine.StartsWith("Pixelxmm=") Then
Dim dTmp As Double
StringToDouble(sLine.Substring(9), dTmp)
If dTmp > EPS_SMALL Then
dMMxPixel = 1 / dTmp
End If
End If
Loop
sr.Close()
Return True
Catch ex As Exception
EgtOutLog("LoadPhoto Error on auxfile : " & sAuxPath)
Return False
End Try
End Function
Private Function ReadStandardAuxData(sAuxPath As String,
ByRef nSlabId As Integer, ByRef sBlockCode As String, ByRef sSlabCode As String, ByRef sSlabName As String, ByRef sMat As String,
ByRef dThick As Double, ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double, ByRef dCoeff As Double) As Boolean
nSlabId = 0
sBlockCode = ""
sSlabCode = ""
sSlabName = ""
sMat = ""
dThick = 0
dCoeff = 1
Try
Dim sLine As String = String.Empty
Dim sr As StreamReader = New StreamReader(sAuxPath)
Do While sr.Peek() > -1
sLine = sr.ReadLine()
sLine = sLine.Replace(" ", "")
If sLine.StartsWith("X=") Then
StringToDouble(sLine.Substring(2), ptOri.x)
ElseIf sLine.StartsWith("Y=") Then
StringToDouble(sLine.Substring(2), ptOri.y)
ElseIf sLine.StartsWith("Z_Lastra=") Then
StringToDouble(sLine.Substring(9), ptOri.z)
ElseIf sLine.StartsWith("X_ScaleCenter=") Then
StringToDouble(sLine.Substring(14), ptCen.x)
ElseIf sLine.StartsWith("Y_ScaleCenter=") Then
StringToDouble(sLine.Substring(14), ptCen.y)
ElseIf sLine.StartsWith("Z_ScaleCenter=") Then
StringToDouble(sLine.Substring(14), ptCen.z)
ElseIf sLine.StartsWith("Pixelxmm=") Then
Dim dTmp As Double
StringToDouble(sLine.Substring(9), dTmp)
If dTmp > EPS_SMALL Then
dMMxPixel = 1 / dTmp
End If
End If
Loop
sr.Close()
Return True
Catch ex As Exception
EgtOutLog("LoadPhoto Error on auxfile : " & sAuxPath)
Return False
End Try
End Function
'Private Function ReadCustomAuxData(sPath As String,
' ByRef nSlabId As Integer, ByRef sBlockCode As String, ByRef sSlabCode As String, ByRef sSlabName As String, ByRef sMat As String,
' ByRef dThick As Double, ByRef ptOri As Point3d, ByRef ptCen As Point3d, ByRef dMMxPixel As Double, ByRef dCoeff As Double) As Boolean
' ' Definizione variabili
' EgtLuaCreateGlobTable("RDT")
' EgtLuaSetGlobStringVar("RDT.FILE", sPath)
' ' Esecuzione
' Dim nErr As Integer = 999
' If EgtLuaExecFile(OmagOFFICEMap.refMainWindowVM.MainWindowM.sImgAutoDir & "\ReadData.lua") AndAlso
' EgtLuaCallFunction("RDT.ReadData") Then
' ' Verifica stato di errore
' EgtLuaGetGlobIntVar("RDT.ERR", nErr)
' End If
' If nErr <> 0 Then
' EgtOutLog("Error in ReadData : " & nErr.ToString())
' Return False
' End If
' ' Leggo i risultati
' If Not EgtLuaGetGlobIntVar("RDT.SLABID", nSlabId) Then nSlabId = 0
' If Not EgtLuaGetGlobStringVar("RDT.SLABNAME", sSlabName) Then sSlabName = String.Empty
' If Not EgtLuaGetGlobStringVar("RDT.BLOCKCODE", sBlockCode) Then sBlockCode = String.Empty
' If Not EgtLuaGetGlobStringVar("RDT.SLABCODE", sSlabCode) Then sSlabCode = String.Empty
' If Not EgtLuaGetGlobStringVar("RDT.MATERIAL", sMat) Then sMat = String.Empty
' if Not EgtLuaGetGlobNumVar("RDT.TH", dThick) Then dThick = 0
' EgtLuaGetGlobPointVar("RDT.ORI", ptOri)
' EgtLuaGetGlobPointVar("RDT.CEN", ptCen)
' EgtLuaGetGlobNumVar("RDT.COEFF", dCoeff)
' EgtLuaGetGlobNumVar("RDT.MMXPIXEL", dMMxPixel)
' EgtLuaResetGlobVar("RDT")
' Return True
'End Function
Public Function GetPhotoName() As String
' Recupero il nome del gruppo di lavoro corrente
Dim sMGrp As String = String.Empty
If Not EgtGetMachGroupName(EgtGetCurrMachGroup(), sMGrp) Then Return ""
' Creo il nome della foto
Return PHOTO_NAME & sMGrp
End Function
Public Function GetPhoto() As Integer
' Recupero Id del gruppo delle foto
Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)
' Recupero Id della foto
' Return EgtGetFirstNameInGroup(nPhGrpId, GetPhotoName())
Return EgtGetFirstNameInGroup(nPhGrpId, PHOTO_NAME)
End Function
Public Function GetPhotoTexturePath() As String
' Recupero la foto
Dim nId As Integer = GetPhoto()
If nId = GDB_ID.NULL Then Return ""
' Recupero la path della texture
Dim sPath As String = String.Empty
If EgtGetPhotoPath(nId, sPath) Then
Return sPath
Else
Return ""
End If
End Function
Public Function GetPhotoTextureRef(ByRef refTxr As Frame3d) As Boolean
' Recupero la foto
Dim nId As Integer = GetPhoto()
If nId = GDB_ID.NULL Then Return False
' Recupero il riferimento in globale
Return EgtGetTextureFrame(nId, GDB_ID.ROOT, refTxr)
End Function
Public Function ShowPhoto(ByVal bShow As Boolean, Optional bDisableModified As Boolean = True) As Boolean
' Recupero la foto
Dim nId As Integer = GetPhoto()
If nId = GDB_ID.NULL Then Return False
' Se richiesto, disabilito impostazione modificato
Dim bOldEnMod As Boolean = False
If bDisableModified Then
bOldEnMod = EgtGetEnableModified()
If bOldEnMod Then EgtDisableModified()
End If
' Ne cambio lo stato
Dim bOk As Boolean = EgtSetStatus(nId, If(bShow, GDB_ST.ON_, GDB_ST.OFF))
' Se necessario, ripristino precedente impostazione modificato
If bOldEnMod Then EgtEnableModified()
Return bOk
End Function
Public Function GetPhotoOffsetRot(ByRef dOffsetX As Double, ByRef dOffsetY As Double, ByRef dRot As Double) As Boolean
' Verifico esistenza oggetto foto
Dim nPhotoId As Integer = GetPhoto()
If nPhotoId = GDB_ID.NULL Then Return False
' Recupero valori
If Not EgtGetInfo(nPhotoId, "OffsX", dOffsetX) Then dOffsetX = 0
If Not EgtGetInfo(nPhotoId, "OffsY", dOffsetY) Then dOffsetY = 0
If Not EgtGetInfo(nPhotoId, "Rot", dRot) Then dRot = 0
Return True
End Function
Public Function UpdatePhoto() As Boolean
' Verifico esistenza oggetto foto
Dim nPhotoId As Integer = GetPhoto()
If nPhotoId = GDB_ID.NULL Then Return False
' Verifico esistenza texture della foto
Dim sPath As String = String.Empty
If Not EgtGetPhotoPath(nPhotoId, sPath) OrElse Not File.Exists(sPath) Then Return False
' Recupero i dati aggiuntivi della foto
Dim ptOri As New Point3d(0, 0, 0)
If Not EgtGetPhotoOrigin(nPhotoId, ptOri) Then Return False
Dim ptCen As New Point3d(0, 0, 1)
If Not EgtGetPhotoCenter(nPhotoId, ptCen) Then Return False
Dim dDimX, dDimY As Double
If Not EgtGetPhotoDimensions(nPhotoId, dDimX, dDimY) Then Return False
' Recupero origine della tavola
Dim ptTab As Point3d
If Not EgtGetTableRef(1, ptTab) Then Return False
' Porto i punti in locale
ptOri.ToLoc(New Frame3d(ptTab))
ptCen.ToLoc(New Frame3d(ptTab))
' Altezza eventuale tavola aggiuntiva
'Dim dAddTable As Double = CurrentMachine.dAdditionalTable
' Aggiusto dati per spessore grezzo (Coefficiente di scalatura)
' (ptCen.z - EstCalc.GetRawHeight() - dAddTable)
Dim dFsca As Double = (ptCen.z - EstCalc.GetRawHeight()) / (ptCen.z - ptOri.z)
dDimX *= dFsca
dDimY *= dFsca
ptOri.x = ptCen.x + (ptOri.x - ptCen.x) * dFsca
ptOri.y = ptCen.y + (ptOri.y - ptCen.y) * dFsca
' ptOri.z = EstCalc.GetRawHeight() + dAddTable
ptOri.z = EstCalc.GetRawHeight()
' Porto i punti in globale
ptOri.ToGlob(New Frame3d(ptTab))
ptCen.ToGlob(New Frame3d(ptTab))
' Carico gli offset
Dim dOffsetX As Double = 0
EgtGetInfo(nPhotoId, "OffsX", dOffsetX)
Dim dOffsetY As Double = 0
EgtGetInfo(nPhotoId, "OffsY", dOffsetY)
Dim dRot As Double = 0
EgtGetInfo(nPhotoId, "Rot", dRot)
' Recupero le dimensioni della tavola
Dim ptMin, ptMax As Point3d
If Not EgtGetTableArea(1, ptMin, ptMax) Then Return False
' Elimino precedente foto
EgtErase(nPhotoId)
' Se non esiste il gruppo per le foto, lo creo
Dim nPhGrpId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, PHOTO_GRP)
If nPhGrpId = GDB_ID.NULL Then
nPhGrpId = EgtCreateGroup(GDB_ID.ROOT)
If nPhGrpId = GDB_ID.NULL Then Return False
EgtSetName(nPhGrpId, PHOTO_GRP)
End If
EgtSetLevel(nPhGrpId, GDB_LV.SYSTEM)
' Carico la fotografia
Dim nNewPhotoId As Integer = EgtAddPhoto2(GetPhotoName(), sPath, ptOri, ptCen, dDimX, dDimY, nPhGrpId, ptMin, ptMax)
If nNewPhotoId = GDB_ID.NULL Then Return False
' Eseguo eventuale rotazione attorno all'origine
EgtRotatePhoto(nNewPhotoId, ptOri, Vector3d.Z_AX(), dRot)
' Salvo gli offset
EgtSetInfo(nNewPhotoId, "OffsX", dOffsetX)
EgtSetInfo(nNewPhotoId, "OffsY", dOffsetY)
EgtSetInfo(nNewPhotoId, "Rot", dRot)
Return True
End Function
Public Function ChangeOffsetPhoto(dOffsetX As Double, dOffsetY As Double) As Boolean
' Verifico esistenza oggetto foto
Dim nPhotoId As Integer = GetPhoto()
If nPhotoId = GDB_ID.NULL Then Return False
' Verifico esistenza texture della foto
Dim sPath As String = String.Empty
EgtGetPhotoPath(nPhotoId, sPath)
If Not File.Exists(sPath) Then Return False
' Recupero offset corrente
Dim dOldOffsX As Double = 0
EgtGetInfo(nPhotoId, "OffsX", dOldOffsX)
Dim dOldOffsY As Double = 0
EgtGetInfo(nPhotoId, "OffsY", dOldOffsY)
' Eseguo traslazione
Dim vtMove As New Vector3d(dOffsetX - dOldOffsX, dOffsetY - dOldOffsY, 0)
EgtMovePhoto(nPhotoId, vtMove)
' Aggiorno valori di offset
EgtSetInfo(nPhotoId, "OffsX", dOffsetX)
EgtSetInfo(nPhotoId, "OffsY", dOffsetY)
Return True
End Function
Public Function ChangeRotationPhoto(ptAx As Point3d, dRot As Double) As Boolean
' Verifico esistenza oggetto foto
Dim nPhotoId As Integer = GetPhoto()
If nPhotoId = GDB_ID.NULL Then Return False
' Verifico esistenza texture della foto
Dim sPath As String = String.Empty
EgtGetPhotoPath(nPhotoId, sPath)
If Not File.Exists(sPath) Then Return False
' Recupero rotazione corrente
Dim dOldRot As Double = 0
EgtGetInfo(nPhotoId, "Rot", dOldRot)
' Eseguo rotazione
EgtRotatePhoto(nPhotoId, ptAx, Vector3d.Z_AX(), dRot - dOldRot)
' Aggiorno valore di rotazione
EgtSetInfo(nPhotoId, "Rot", dRot)
Return True
End Function
Public Function UpdateContour() As Boolean
' Verifico esistenza oggetto contorno
Dim nCrvId As Integer = GetContour()
If nCrvId = GDB_ID.NULL Then Return False
' Verifico esistenza oggetto foto
Dim nPhotoId As Integer = GetPhoto()
If nPhotoId = GDB_ID.NULL Then Return False
' Recupero centro della foto
Dim ptCen As New Point3d(0, 0, 1)
EgtGetPhotoCenter(nPhotoId, ptCen)
' Recupero origine della tavola
Dim ptTab As Point3d
If Not EgtGetTableRef(1, ptTab) Then Return False
' Altezza eventuale tavola aggiuntiva
'Dim dAddTable As Double = CurrentMachine.dAdditionalTable
' Recupero inizio contorno
Dim ptStart As Point3d
EgtStartPoint(nCrvId, GDB_ID.ROOT, ptStart)
' Calcolo coefficiente di scalatura
Dim dFsca As Double = (ptCen.z - ptTab.z - EstCalc.GetRawHeight()) / (ptCen.z - ptStart.z)
' Scalo opportunamente
EgtScale(nCrvId, New Frame3d(ptCen), dFsca, dFsca, 1, GDB_RT.GLOB)
' Sposto in Z
Dim vtMove As New Vector3d(0, 0, ptTab.z + EstCalc.GetRawHeight() - ptStart.z)
EgtMove(nCrvId, vtMove, GDB_RT.GLOB)
Return True
End Function
Public Function GetContour() As Integer
Dim nPartId As Integer = EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_RAW_PHOTO_OUTLINE)
Dim nLayerId As Integer = EgtGetFirstGroupInGroup(nPartId)
Dim nCrvId As Integer = EgtGetFirstInGroup(nLayerId)
Return nCrvId
End Function
Friend Sub RemoveContour()
EgtErase(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_RAW_PHOTO_OUTLINE))
End Sub
Public Sub ShowContour(bShow As Boolean)
' Disabilito impostazione modificato
Dim bOldEnMod As Boolean = EgtGetEnableModified()
If bOldEnMod Then EgtDisableModified()
' Cambio stato di visualizzazione
EgtSetStatus(EgtGetFirstNameInGroup(GDB_ID.ROOT, NAME_RAW_PHOTO_OUTLINE), If(bShow, GDB_ST.ON_, GDB_ST.OFF))
' Se necessario, ripristino precedente impostazione modificato
If bOldEnMod Then EgtEnableModified()
End Sub
End Module