- Kod: Tümünü seç
Option Explicit
Dim Ni As NestInformation
Public Sub Test()
Dim iNumSheets As Integer
Dim lFirstOp As Long
Dim lLastOp As Long
Dim lLastSheetOp As Long
Dim LastTool As MillTool
Dim i As Integer
Dim lCount As Long
Dim NewOpNo As Long
Dim NestInfo As NestInformation
Dim Ns As NestSheet
Dim colSheetID As New Collection
Set NestInfo = ActiveDrawing.GetNestInformation
For Each Ns In NestInfo.Sheets
If UCase(Right(Ns.Name, 4)) <> "_REV" Then
colSheetID.Add DetermineSheetID(Ns.Name)
End If
Next
Set Ni = ActiveDrawing.GetNestInformation
iNumSheets = colSheetID.Count
Set LastTool = App.SelectTool("T1")
App.DisableUndo = True
For i = 1 To iNumSheets
colSheetID (i)
GetSheetFirstAndLastOperation "Sheet " & colSheetID(i), lFirstOp, lLastOp
lLastSheetOp = lLastOp
lCount = lFirstOp
NewOpNo = lLastOp + 1
Do While lCount <= lLastSheetOp
MsgBox (ActiveDrawing.Operations(lCount).Tool.Number)
MsgBox (ActiveDrawing.Operations(lCount).Tool.Name)
If ActiveDrawing.Operations(lCount).Tool.Number = "1" _
And ActiveDrawing.Operations(lCount).Tool.Name = "T1" Then
ActiveDrawing.Operations.Renumber lCount, NewOpNo, acamOpINSERT_IN_FRONT
End If
lCount = lCount + 1
Loop
ActiveDrawing.Operations.OrderAll
Next
ActiveDrawing.ZoomAll
End Sub
Public Function DetermineSheetID(SheetName As String) As String
Dim iCount As Integer
Dim sLetter As String
Dim bFound As Boolean
For iCount = Len(SheetName) To 1 Step -1
If Not IsNumeric(Mid(SheetName, iCount, 1)) Then
bFound = True
Exit For
End If
Next
If bFound Then
sLetter = Mid(SheetName, iCount)
DetermineSheetID = sLetter
Else
MsgBox "Cannot determine Sheet Letter for sheet: " & SheetName, vbExclamation
End If
End Function
Private Sub GetSheetFirstAndLastOperation(SheetName As String, FirstOp As Long, LastOp As Long)
Dim TestPath As Path
Dim lLastOp As Long
Dim lFirstOp As Long
Dim iSheetNum As Integer
lLastOp = Ni.Sheets(SheetName).Paths(1).OpNo
lFirstOp = Ni.Sheets(SheetName).Paths(1).OpNo
For Each TestPath In Ni.Sheets(SheetName).Paths
If TestPath.OpNo > lLastOp Then lLastOp = TestPath.OpNo
If TestPath.OpNo < lFirstOp And TestPath.OpNo <> 0 And TestPath.IsToolPath Then lFirstOp = TestPath.OpNo
Next
LastOp = lLastOp
FirstOp = lFirstOp
End Sub
Merhabalar
Bu hazirlamis oldugum kodlar. 32bit versiyonda sorun cikartmiyor.64 bit sisteme gecis yapilinca surekli hata uyarisi veriyor.
Olusan hatanin duzeltilmesi icin yardimci olursaniz memnun olurum.
iyi calismalar dilerim.