View difference between Paste ID: Y1mzxD8m and TCFCmfLQ

-'VRB Pubbliche
+'Solid DXF
 
-Option Explicit
+Dim swApp As SldWorks.SldWorks
 Dim Model As ModelDoc2
-Public PRG_NUM(5) As String 'MATRICE CON NUMERI DI PROGRAMMA
+Dim DTable As DesignTable
-Public PRG_TOT As String 'NUMERO PROGRAMMA FINALE
+Dim WS_OBJ As Excel.Worksheet
-Public YEARS As Integer 'ANNO
+Dim part As Object
 Dim SelMgr As Object
-Public INPUT_FOLDER As String 'CARTELLE
+Dim NR_View As Byte
-Public OUTPUT_FOLDER As String
+
-Public SLD_PTH As String
+
-Public DXF_FOLD As String
+Sub MODEL_SUB(ByVal NFD As String, ByVal ACTACT As Byte)
-Public DXF_CFOLD As String
+ACT_MOD = INFO_DAT(NFD, 0, 6)
-Public NST_FOLD As String
+
-'Public NST_FOLD2 As String
+Set swApp = CreateObject("SldWorks.Application")
-Public SPC_FOLD As String
+swApp.Visible = False
-Public FNLANTE_FOLDER As String
+
-Public DXF_ANTE_18 As String
+Set part = swApp.OpenDoc6(SLD_PTH & Left(INFO_DAT(NFD, 0, 6), 10) & INFO_DAT(NFD, 0, 9) & ".SLDPRT", 1, 0, "", 0, 0) 'AGGIUNTA REVISIONE
-Public DXF_ANTE_15 As String
+Select Case swApp.ActiveDoc.Extension.HasDesignTable()
 Case True
 Case False
-Public NN_CODE As Integer 'NUMERO CODICI PER PRODUZIONE ESTERNA
+MsgBox "THIS FILE DO NOT CONTAINS ANY TABLE DESIGN", vbCritical
-Public NN_MAT As Integer 'NUMERO MATERIALI PER PRODUZIONE ESTERNA
+Exit Sub
-Public STR_COD(1000) As String 'MATRICE CON I CODICI DELLE PORTE
+End Select
-Public STR_MTR(40) As String 'MATRICE CON MATERIALI
+Set Model = swApp.ActiveDoc
 filePth = Model.GetPathName
 
-Public INFO_VAR(4, 100) As String                        'MATRICE TRASPORTO DATI; LA RIGA 0 CONTIENE I DATI GENERALI LA RIGA 1 CONTIENE LE ETICHETTE, LA RIGA 2 I CORRISPONDENTI VALORI
+STR_FNAME = Right(filePth, InStr(1, StrReverse(filePth), "\", vbBinaryCompare) - 1)
-Public INFO_DAT(5000, 2, 100) As String                  'MATRICE DATI COMPLESSIVA:IL 1°INDICE E'PROGRESSIVO FILE GLI ALTRI SONO INFO _VAR
+
-Public INFO_PST(5000, 2, 100) As String                  'MATRICE DATI FILE CSV PIASTRONI FIBRA
+Set DTable = Model.GetDesignTable
-Public NM_DT As Integer                                  'NUMERO DATI TOTALI
+GET_ERR = swApp.GetErrorMessages(vMsgs, vMsgIds, vMsgTypes) 'RESETTA LO STACK MESSAGGI
 
-Public DXF_LST As Variant, I2 As Integer                 'LISTE DXF INTERNI, DXF ESTERNI E PROGRAMMI S4
+isGood = DTable.Attach
-'Public DXF_LST_EXT As Variant, I1 As Integer
+If isGood = False Then
-'Public DXF_LST_EXT2 As Variant, I12 As Integer
+MsgBox "Table attachment failed", vbCritical
-Public DXF_OUT As Variant, I3 As Integer
+Exit Sub
-'Public DXF_18 As Variant, I4 As Integer
+End If
-'Public DXF_15 As Variant, I5 As Integer
+
 Set WS_OBJ = DTable.Worksheet
 Call TAB_EDT(NFD)
-Public VAR_APE As Integer                                'VARIABILE CHE DICE SE PRODURRE INTERNAMENTE O ESTERNAMENTE
+Call MOD_CHECK(NFD)
-Public VCF As Integer
+
 VVVV = Replace(INFO_DAT(NFD, 0, 7), "H", "")
-Public TOOL_VAR(20, 100, 7) As String                   'MATRICE DATI TORRETTA CARICATA DAL FOGLIO TOOLS
+VVVV = Replace(VVVV, "G", "")
 VVVV = Replace(VVVV, "P", "")
 VVVV = Val(VVVV)
-Public ACT_MOD As String
+
-Public NHD As Integer
+ VW = VW_SET(VVVV)
  RW = DTable.Worksheet.Range("VW_ROT", "VW_ROT").Value
  MD = INFO_DAT(NFD, 0, 9)
 
-Public QCSP As Single
+For i = 1 To 100
-Public PULS_TYPE As Byte
+If InStr(1, INFO_DAT(NFD, 1, i), "MOD", vbTextCompare) > 0 Then
-Public INDIC_TYPE As Byte
+REV_ON_DAT = INFO_DAT(NFD, 2, i)
-Public CUR_COM As String
+Exit For
 End If
 Next i
-Public BLC_DAT(5000, 10, 100) As String 'matrice e variabili per validazione dati fineline
+
-Public kl As Integer
+If MD <> REV_ON_DAT Then MsgBox "ATTENZIONE: INDICE DI REVISIONE ERRATO SU MODELLO " & INFO_VAR(0, 0), vbCritical
     DTable.UpdateModel
-'**************************************************************************************************************
+    DTable.Detach
 GET_ERROR = swApp.GetErrorMessages(vMsgs, vMsgIds, vMsgTypes)
-Public MAT_NST(20, 1000, 4, 3) As String 'MATRICE PER IL NESTING
+If GET_ERROR > 0 Then INFO_DAT(NFD, 0, 20) = ERR_TRAPP(GET_ERROR, vMsgs, vMsgIds, vMsgTypes) Else INFO_DAT(NFD, 0, 20) = ""
-Public MATNEST(20, 200, 10) As String
+
 Call SUB_DXF(NFD, VW, RW, ACTACT)
-Public ANT_NST(20, 1000, 8, 3) As String 'MATRICE PER IL NESTING ANTE
+
-Public ANTNST(20, 500, 2) As String
+Erase INFO_VAR
 NR_View = Empty
 
-Public INST(17, 150, 40, 40, 14) As String              'MATRICE INFO NESTING
+Set part = swApp.ActiveDoc
 Set SelMgr = part.SelectionManager
-'(0,0,0,0,1) = NUMERO PROGRAMMA
+Set part = Nothing
-'(0,0,0,0,2) = NUMERO MATERIALI PRESENTI DA NESTRARE
+swApp.CloseDoc STR_FNAME
-'(0,0,0,0,3) = DIMENSIONE TAGLIO IN X
+'swApp.ExitApp
-'(0,0,0,0,4) = DIMENSIONE TAGLIO IN Y
+
-'(0,0,0,0,5) = MASSIMO SVUOTAMENTO IN X A DX DEL PEZZO
+
-'(0,0,0,0,6) = MASSIMO RIFILO IN X A SX DEI PEZZI OLTRE IL QUALE IL FOGLIO VIENE TAGLIATO
+RRR:
-'(NM,0,0,0,0) = NOME DEL MATERIALE NM
+
-'(NM,0,0,0,1) = NUMERO DI NESTING NEL MATERILAE NM
+
-'(NM,0,0,0,2) = SPESSORE DEL MATERIALE
+End Sub
 
-'(NM,NN,0,0,0) = NOME DEL N-ESIMO NESTING DEL MATERIALE NM
+Sub TAB_EDT(ByVal NFG As Integer)
-'(NM,NN,0,0,1) = TESTA DEL N-ESIMO NESTING DEL MATERIALE NM
+Set DTable = part.GetDesignTable
-'(NM,NN,0,0,2) = QUANTITà DEL N-ESIMO NESTING DEL MATERIALE NM
+If DTable.Attach = False Then
-'(NM,NN,0,0,3) = DIMENSIONE Y DEL N-ESIMO NESTING DEL MATERIALE NM
+MsgBox "Table attachment failed", vbCritical
-'(NM,NN,0,0,4) = DIMENSIONE X DEL N-ESIMO NESTING DEL MATERIALE NM
+Exit Sub
-'(NM,NN,0,0,5) = NUMERO RIGHE DEL N-ESIMO NESTING DEL MATERIALE NM
+End If
-'(NM,NN,0,0,6) = STRINGA DEL N-ESIMO NESTING DEL N-ESIMO MATERIALE
+
-'(MN,NN,0,0,8) = ALTEZZA TOP DEL MATERIALE MN E DEL NESTING NN
+On Error GoTo ERR_LBL
-'(MN,NN,0,0,9) = BANDELLA IN PINZA O IN ALTO
+VARCOUNT = 0
-'(MN,NN,0,0,10) = SVUOTAMENTO LATERALE MINIMO DEL MATERIALE MN, DEL NESTING NN
+TAB_NAM = ActiveWorkbook.Name
-'(MN,NN,0,0,11) = NUMERO COMPLESSIVO PEZZI CONTENUTI UN NESTING
+For Each NAMS In Workbooks(TAB_NAM).Names
-'(MN,NN,0,0,12) = SHIFT Y DEL NESTING (SI USA IN CASO DI UTILIZZO PARZIALE IN Y DEL FOGLIO, I PEZZI VENGONO ALLONTANATI DALLE PINZE DELLA QUANTITA' SHIFT Y)
+If InStr(1, NAMS.Name, "VAR_", vbBinaryCompare) Then
-'(MN,NN,0,0,13) = MINORE SPOSTAMENTO LATERALE SINISTRO DEL MATERIALE MN, DEL NESTING NN E DELLA RIGA RR MA > 250 - PER BANDELLA LATERALE DX
+DTable.Worksheet.Range(NAMS.Name, NAMS.Name).Value = 0
 VARCOUNT = VARCOUNT + 1
-'(NM,NN,RR,0,0) = NUMERO DI COLONNE DELLA N-ESIMA RIGA DEL N-ESIMO NESTING DEL N-ESIMO MATERIALE
+End If
-'(NM,NN,RR,0,7) = ALTEZZA DELLA RIGA RR, NESTING NN E MATERIALE NM
+Next NAMS
-'(MN,NN,RR,0,10) = SVUOTAMENTO LATERALE DESTRO DEL MATERIALE MN, DEL NESTING NN E DELLA RIGA RR
+
-'(MN,NN,RR,0,11) = SPOSTAMENTO LATERALE SINISTRO DEL MATERIALE MN, DEL NESTING NN E DELLA RIGA RR
+For i = 1 To 100
-'(MN,NN,RR,0,12) = DIMENSIONE IN X DELLA RIGA RR, DEL NESTING NN E DEL MATERIALE MN
+LAB = Replace(INFO_DAT(NFG, 1, i), ".", "")
 VLR = INFO_DAT(NFG, 2, i)
-'(NM,NN,RR,CC,0) = NOME DELLA PARTE
+
-'(NM,NN,RR,CC,1) = DIMENSIONE X DELLA PARTE
+If InStr(1, LAB, "VER", vbBinaryCompare) > 0 Then
-'(NM,NN,RR,CC,2) = DIMENSIONE Y DELLA PARTE
+VLR = Replace(VLR, "H", "")
-'(NM,NN,RR,CC,3) = COORDINATA X DELLA PARTE
+VLR = Replace(VLR, "G", "")
-'(NM,NN,RR,CC,4)= COORDINATA Y DELLA PARTE
+VLR = Replace(VLR, "P", "")
-'(MN,NN,RR,CC,5) = SPESSORE DELLA PARTE
+VLR = Val(VLR)
-'(MN,NN,RR,CC,6) = CONTROLLO TESTA DELLA PARTE
+End If
-'(NM,NN,RR,CC,9) = COORDINATA X FINALE DELLA PARTE
+
-'(NM,NN,RR,CC,10) = COORDINATA Y SUP DELLA PARTE
+For Each NAMS In Workbooks(TAB_NAM).Names
-'(MN,NN,RR,CC,8) = COMMESSA DELLA PARTE
+If InStr(1, NAMS.Name, ".", vbBinaryCompare) > 0 Then MsgBox "ERRORE ETICHETTA SU TABELLA " & swApp.ActiveDoc
-'(MN,NN,RR,CC,7) = CODICE DISEGNO DELLA PARTE
+If NAMS.Name = "VAR_" & LAB Then
-'(MN,NN,RR,CC,11) = COORDINATA SCARICO DELLA PARTE
+DTable.Worksheet.Range("VAR_" & LAB, "VAR_" & LAB).Value = VLR
 VARWRITE = VARWRITE + 1
 End If
-Public STR_OUT(32) As String 'COMANDI DI SCARICO PER PAR
+Next NAMS
-Public CLAMP As Integer 'COMANDI PER PEZZO IN PINZA O NO
+Next i
-Public PUNCHING_MACHINE As String
+
 DTable.UpdateModel
-'TOOL
+DTable.Detach
-Public TL_CUT_V As String
+GoTo ENDSUB
-Public TL_CUT_V2 As String
+ERR_LBL:
-Public LUTV As Double
+MsgBox "ERRORE SU TABELLA " & INFO_DAT(NFG, 0, 6)
-Public LUTV2 As Double
+ENDSUB:
-Public TL_CUT_O As String
+End Sub
-Public LUTH As Double
+
-Public TL_CUT_SQ1 As String
+Sub SUB_DXF(ByVal NFG As Integer, ByVal V_VIEW As Byte, ByVal R_VIEW As Double, ByVal ACTACT As Byte)
-Public TL_CLN As String
+
-Public TL_MCRG As String
+Dim boolstatus As Boolean
-Public TCUT As Double
+Dim longstatus As Long, longwarnings As Long
-Public H_SQ1 As Double
+Dim Feature As Object
-Public OFS_TRAV As Double
+Dim filePth As String
-Public LRC As Double
+Dim DrawWiew As Object
-Public RRC As Double
+Dim sVWiew  As SldWorks.View
-Public x_LRC As Double
+
 Set swModel = swApp.ActiveDoc
-'RIFILI
+Set part = swApp.ActiveDoc
-Public RIF_SUP As Double
+Set SelMgr = part.SelectionManager
-Public RIF_SX As Double
+
-Public RIF_DX As Double
+filePth = swModel.GetPathName
-Public RIF_ANT As Double
+drvVal = Left(filePth, 1)
-Public BANDL As Double
+lenext = InStr(1, StrReverse(filePth), "\", vbBinaryCompare) - 1
-Public MCR_X As Double
+fileName = Left(Right(filePth, lenext), Len(Right(filePth, lenext)) - InStr(1, StrReverse(Right(filePth, lenext)), ".", vbBinaryCompare))
-Public MCR_Y As Double
+
 part.SetBendState 2
-Public POS_PINZE As String
+boolstatus = part.EditRebuild3
 
 'Set part = swApp.OpenDoc6("\\NT1\TEP-VAULT\SWP\WitturETODrawing.DRWDOT", 3, 0, "", longstatus, longwarnings)
-Public NPAR_FLD As String
+Set part = swApp.OpenDoc6("\\nt1\UFFTEP\3D_parametrizzati\SWP\WitturETODrawing.DRWDOT", 3, 0, "", longstatus, longwarnings)
-Public PAR_FLD As String
+Set DrawWiew = part.CreateDrawViewFromModelView2(filePth, VDS(V_VIEW), 0, 0, 0)
-Public VPR_FLD As String
+
-Public PDF_FLD As String
+boolstatus = part.Extension.SelectByID2(NAME_VW, "DRAWINGVIEW", 0, 0, 0, False, 0, Nothing, 0)
-Public IN_FLD As String
+boolstatus = part.DrawingViewRotate(R_VIEW / 57.29578)   'TO ROTATE VIEW
-Public VIPROS_FLD As String
+
-Public PAR_DXF_FLD As String
+    Set swModel = swApp.ActiveDoc
     Set swSelMgr = swModel.SelectionManager
-Public STIPITI As String
+    Set swModelDocExt = swModel.Extension
-Public STIPITI_PORTALI As String
+
-Public LATO_BATTUTA As String
+ Call DRW_CLR(1)
-Public STIPITI_SLIM As String
+
-Public RIVESTIMENTI_SLIM As String
+
-Public ANTE As String
+If ACTACT = 1 Then
-Public ANTE_2 As String
+If Application.UserName = "Galloni A." Or Application.UserName = "Sassi, Samuele (Wittur Italy)" Or Application.UserName = "Armencea, Decebal (Wittur Italy)" Then
-Public RIV_2 As String
+part.SaveAs2 OUTPUT_FOLDER & INFO_DAT(NFG, 0, 16) & ".DXF", 0, True, False 'NOME CON CUI SI SALVA IL DXF
-Public RIVESTIMENTI_ANTA As String
+Else
-Public RINFORZI_SALD As String
+part.SaveAs2 DXF_CFOLD & INFO_DAT(NFG, 0, 16) & ".DXF", 0, True, False 'NOME CON CUI SI SALVA IL DXF
-Public RINFORZI_MTG As String
+End If
-Public TRAVERSA As String
+End If
-Public TRAVERSA_PORTALE As String
+If ACTACT = 2 Then part.SaveAs2 OUTPUT_FOLDER & INFO_DAT(NFG, 0, 16) & ".DXF", 0, True, False
-Public SOTTOSOGLIA As String
+
-Public RINFORZI_TRF As String
+
-Public STAFFE As String
+Set part = swApp.ActiveDoc
-Public COPRIFESSURA As String
+Set SelMgr = part.SelectionManager
-Public PARAMENTI As String
+Set part = Nothing
-Public ENTRANCE As String
+swApp.CloseDoc swApp.ActiveDoc.GetTitle
-Public ALTRO_TRF As String
+Set part = swApp.ActivateDoc2(filePth, False, longstatus)
-Public ALTRO_VPR As String
+
-Public ALTRO_EMZ As String
+part.SetBendState 3
-Public PIASTRONI_CAR As String
+boolstatus = part.EditRebuild3
-Public PIASTRONI_LAND As String
+
-Public ENTRANCE_2 As String
+
 End Sub
 
-Public PREV As String
+
-Public FORMATISS(200, 8) As String
+Function VDS(ByVal NVIEW As Byte) As String
-Public BONOS(1500, 2) As String
+
-Public YYERR As String
+LNG = UCase(swApp.GetCurrentLanguage)
 
 Select Case LNG
-Public DSCM(200, 2) As String
+Case "ENGLISH"
-Public INFO_MAT(200, 11) As String
+ CLang = 1
-Public tiemp(200, 2) As String
+Case "ITALIANO", "ITALIAN"
  CLang = 2
-Public SPC_R_OLD As String
+Case Else
-Public QCSP_OLD As Single
+MsgBox "Errore su linguaggio", vbCritical
-Public VAR_ACCORP As Integer
+End Select
-Public VAR_PIASTRFIBRA As Integer
+
-Public VAR_ERRACC As Integer
+Select Case NVIEW
 Case 1
-Public TL_PUNCH(2000, 200) As String
+  If CLang = 1 Then VDS = "*Top"
-Public tool_use(50, 2) As String
+  If CLang = 2 Then VDS = "*Superiore"
 Case 2
-Public FNL_SEQUENCING As Integer
+  If CLang = 1 Then VDS = "*Bottom"
   If CLang = 2 Then VDS = "*Inferiore"
-Public RPT_SPC(100, 20, 3) As String  'REPORT PER INSERIEMNTO VALORI SPACCHI MANUALMENTE
+Case 3
-Public RP  As Integer                  'CONTATORE RIGHE REPORT
+  If CLang = 1 Then VDS = "*Right"
-Public RP2  As Integer                 'CONTATORE RIGHE REPORT
+  If CLang = 2 Then VDS = "*Destra"
 Case 4
-Public VPRSS As Integer
+  If CLang = 1 Then VDS = "*Left"
   If CLang = 2 Then VDS = "*Sinistra"
-Public comm_omg_spc As String
+Case 5
   If CLang = 1 Then VDS = "*Front"
-Public COD_ETICHETTATI As String
+  If CLang = 2 Then VDS = "*Frontale"
-Public STR_VR_ACC As String
+End Select
-Public STR_VR_FIBRA As String
+
 
-Public LISTA_MAT_FNL As Integer
+End Function
 
-Public FGL_REC As Integer
+
-Public MAT_FGL_RECUPERO As String
+Function NAME_VW() As String
 
-Public ULTF As Integer
+    Dim swModel                 As SldWorks.ModelDoc2
-Public ULTF2(300) As String
+    Dim swDraw                  As SldWorks.DrawingDoc
     Dim swSheet                 As SldWorks.Sheet
     Dim sVWiew                  As SldWorks.View
 
     Set swModel = swApp.ActiveDoc
     Set swDraw = swModel
     Set sVWiew = swDraw.GetFirstView
     Set sVWiew = sVWiew.GetNextView
 
     NAME_VW = sVWiew.GetName2
 
 If NAME_VW <> "" Then Else MsgBox "NESSUNA VISTA CARICATA", vbCritical
 
 
 End Function
 
 
 Function VW_SET(ByVal NV As String) As Byte
 
 NV = Replace(NV, "G", "")
 NV = Replace(NV, "H", "")
 
 On Error Resume Next
 VW_SET = 99
 NVR = Val(Trim(NV))
 
 VW_SET = DTable.Worksheet.Range("VW_00", "VW_00").Value
 If VW_SET = 99 Then
 
 
 Select Case NVR
 Case 1, 3
 VW_SET = DTable.Worksheet.Range("VW_01", "VW_01").Value
 Case 2, 4
 VW_SET = DTable.Worksheet.Range("VW_02", "VW_02").Value
 End Select
 End If
 
 End Function
 
 
 
 
 
 
 Sub DRW_CLR(ByVal ZSD As Byte)
 
 Set swDraw = swApp.ActiveDoc
 Set swSheet = swDraw.GetCurrentSheet
 Set swView = swDraw.GetFirstView
 Set swView = swView.GetNextView
 Set swAnn = swView.GetFirstAnnotation
 Do While Not Nothing Is swAnn
 swAnn.Visible = 3
 Set swAnn = swAnn.GetNext3
 Loop
 
 Set part = swApp.ActiveDoc
 Set SelMgr = part.SelectionManager
 boolstatus = part.SetUserPreferenceToggle(196, False)
 
 End Sub
 
 
 Sub MOD_CHECK(ByVal NFG As Integer)
 
 On Error GoTo ERR
 INFO_VAR(0, 1) = DTable.Worksheet.Range("REV_IND", "REV_IND").Value
 GoTo ENDFUNCT
 ERR:
 MsgBox "ATTENZIONE: NON RILEVATO INDICE DI REVISIONE SU MODELLO " & INFO_DAT(NFG, 0, 0)
 ENDFUNCT:
 
 End Sub
 
 
 Function ERR_TRAPP(Count, vMsgs As Variant, vMsgIds As Variant, vMsgTypes As Variant) As String
 ERR_STR = ""
 For i = 0 To (Count - 1)
 ERR_STR = ERR_STR & " " & vMsgs(i)
 Next i
 ERR_STR = Replace(ERR_STR, Chr(13), "")
 ERR_TRAPP = Trim(Replace(ERR_STR, "Avvertenza: ", ""))
 
 End Function