Тема: Проблема в objSSLocal.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataValue или лыжи не едут?
Задача.
Необходимо проверить трассу на необходимость построение полок и срезок в зависимости от поперечного и продольного уклона.
Решение.
Все работает, но долго: для трассы примерное 7-10 км время обработки составляет примерно 30-50 мин. Пытаюсь оптимизировать.
Оптимизация.
Для рабочего алгоритма программа:
1. Разбивает трассу поиска с заданным шагом. (строиться дублер полинии)
2. Выделяет все полилинии в в объекте по фильтру (слой и объект - полиния).
3. Потом перебором всех полилиний из выборки для каждой разбитой точки на полилинии строиться отрезок ищется его пересечение и пишется в фаил экселя.
Соответственное очень большой объем не нужных постороений:
Хотел сделать выборку по квадрату для данной точки, но она не корректно работает пишутся нули.
Attribute VB_Name = "Section" Option Explicit Const a1 = 1 'Столбец - пустая константа Const a2 = 2 'Столбец - нумерация сечений в файле Const a3 = 3 'Столбец - знак "ПК" Const a4 = 4 'Столбец - целая часть ПК Const a5 = 5 'Столбец - знак "+" Const a6 = 6 'Столбец - плюсовка ПК Const a7 = 7 'Столбец - нумерация сечений в файле EXcel Const a8 = 8 'Столбец - нумерация сечений в файле EXcel Const a9 = 9 'Столбец - нумерация сечений в файле EXcel Const a10 = 10 'Столбец - нумерация сечений в файле EXcel Const a11 = 11 'Столбец - нумерация сечений в файле EXcel Const a12 = 12 'Столбец - Базовая координата сечения X Const a13 = 13 'Столбец - Базовая координата сечения Y Const a14 = 14 'Укзатель на координату (то что не пустая ячейка с координатой) Const A = 40 ' Const PI = 3.14159265358979 Const MscaleX = 1000 Const MscaleY = 100 Const BeginPiket = "0+00" 'Начальный ПК Const Step = 10 'Щаг разбивки полилинии Const StandartPiket = 100 'Стандартный 100 метровый пикет Const StandartKM = 1000 'Стандартный 100 метровый пикет Const BeginRow = 5 'Начало заполнения по строкам Const Polosa = 30 'Ширина исследуемой зоны Public i, j, k, n, m, p As Integer Public objExcelSheet As Object Public objExcel As Object Public lineObj As AcadLine Public TextObj As AcadText Public plineObj As AcadLWPolyline Public MLeader As AcadMLeader Public dimObj As AcadDimAligned Public Sub PreparationLayers() 'Слой и характеристики для полок и срезок Set newLayer = ThisDrawing.Layers.Add("_ЛО_Полки_Срезки") newLayer.Lineweight = acLnWt035 newLayer.Linetype = "Continuous" newLayer.color = acGreen 'Слой и характеристики для полок и срезок Set newLayer = ThisDrawing.Layers.Add("_ЛО_Полки_Срезки_вспомогательный") newLayer.Lineweight = acLnWt035 newLayer.Linetype = "Continuous" newLayer.color = acRed 'Слой и характеристики для полок и срезок Set newLayer = ThisDrawing.Layers.Add("_ЛО_Полки_Срезки_Текст") newLayer.Lineweight = acLnWt035 newLayer.Linetype = "Continuous" newLayer.color = acRed Set newLayer = ThisDrawing.Layers.Add("_ЛО_Размеры") newLayer.Lineweight = acLnWt035 'acLnWtByLwDefault newLayer.Linetype = "Continuous" newLayer.color = acMagenta End Sub Public Sub MainSection() Dim objSSLocal, objSSLocal1, objSSLocal2 As AcadSelectionSet Dim Res As String Dim SelectName As String PreparationLayers 'Подготовка слоев SelectionDelete "N1" SelectName = "N1" Set objSSLocal = SelectPolylineAll("N2") Set objExcel = GetObject(, "Excel.Application") objExcel.Worksheets("Poperechnik").Activate objExcel.Worksheets("Poperechnik").Select ThisDrawing.Utility.Prompt "Выбирите полилинию трассы" Set objSS = ThisDrawing.SelectionSets.Add(SelectName) objSS.SelectOnScreen Set plineObj = objSS.Item(0) Perpendikular plineObj, Polosa 'Сбор координат точек SortCoordinate 'ОБЯЗАТЕЛЬНО ПЕРВАЯ после сбора точек NumberPiket 'Прочая информация по сечениям CalculateUklonGorizont 'Расчет уклона по горизонталям CalculatePolok 'Определение типа полок RazmetkaPolokDim 'Разметка полок End Sub Public Sub Perpendikular(plineObjLocal As AcadLWPolyline, Lkorodor As Double) Dim AngleLine As String 'Угол в радианах поворота граничного участка PolyLine Dim objSSLocalPer As AcadSelectionSet 'Локальная выборка Dim Coord As Variant Dim CrossPoints As Variant Dim StartpointGor(0 To 2) As Double Dim EndpointGor(0 To 2) As Double Dim NStartpointGor(0 To 2) As Double Dim NEndpointGor(0 To 2) As Double Dim TextPoint(0 To 2) As Double Dim LocalCorner(0 To 3) As Double Dim LocalCornerVar As Double Dim PointT(0 To 11) As Double Set objExcel = GetObject(, "Excel.Application") objExcel.Worksheets("Poperechnik").Activate objExcel.Worksheets("Poperechnik").Select i = 0 'Зануление массива данных для поперечников Coord = plineObjLocal.Coordinates 'Перебираем каждую горизонталь на предмет пересечения уровнем Set objSSLocalPer = SelectPolylineAll("N2") For i = 1 To (UBound(plineObj.Coordinates) - 1) / 2 m = a14 'Создани линий по плану полилинии для определения угла AngleLine StartpointGor(0) = Coord(2 * i - 2) StartpointGor(1) = Coord(2 * i - 1) StartpointGor(2) = 0 EndpointGor(0) = Coord(2 * i) EndpointGor(1) = Coord(2 * i + 1) EndpointGor(2) = 0 Set lineObj = ThisDrawing.ModelSpace.AddLine(StartpointGor, EndpointGor) AngleLine = lineObj.Angle 'If StartpointGor(0) > EndpointGor(0) Then 'AngleLine = AngleLine + PI 'End If 'Удаление линий по плану полилинии для определения угла AngleLine lineObj.Delete 'Выбираем все горизонтали (пофильтру: полилиния, слой, границы (для теста "LO")) 'LocalCorner(0) = Coord(2 * i - 2) + Lkorodor '* Cos(PI / 2 - AngleLine) 'LocalCorner(1) = Coord(2 * i - 1) - Lkorodor '* Sin(PI / 2 - AngleLine) 'LocalCorner(2) = Coord(2 * i - 2) - Lkorodor '* Cos(PI / 2 - AngleLine) 'LocalCorner(3) = Coord(2 * i - 1) + Lkorodor '* Sin(PI / 2 - AngleLine) 'objExcel.Worksheets("Poperechnik").Cells(i + BeginRow - 1, a8) = LocalCorner(0) 'objExcel.Worksheets("Poperechnik").Cells(i + BeginRow - 1, a9) = LocalCorner(1) 'objExcel.Worksheets("Poperechnik").Cells(i + BeginRow - 1, a10) = LocalCorner(2) 'objExcel.Worksheets("Poperechnik").Cells(i + BeginRow - 1, a11) = LocalCorner(3) 'PointT(0) = LocalCorner(0) 'PointT(1) = LocalCorner(1) 'PointT(2) = LocalCorner(2) 'PointT(3) = LocalCorner(1) 'PointT(4) = LocalCorner(2) 'PointT(5) = LocalCorner(3) 'PointT(6) = LocalCorner(0) 'PointT(7) = LocalCorner(3) 'PointT(8) = LocalCorner(0) 'PointT(9) = LocalCorner(1) 'PointT(10) = LocalCorner(2) 'PointT(11) = LocalCorner(3) 'Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(PointT) 'Set objSSLocalPer = SelectPolyline("N2", LocalCorner(0), LocalCorner(1), LocalCorner(2), LocalCorner(3)) For j = 0 To objSSLocalPer.count - 1 Set plineObjLocal = objSSLocalPer.Item(j) 'If Int(plineObjLocal.Elevation) <> plineObjLocal.Elevation Then NStartpointGor(0) = StartpointGor(0) - Lkorodor * Cos(PI / 2 - AngleLine) NStartpointGor(1) = StartpointGor(1) + Lkorodor * Sin(PI / 2 - AngleLine) NStartpointGor(2) = plineObjLocal.Elevation NEndpointGor(0) = StartpointGor(0) + Lkorodor * Cos(PI / 2 - AngleLine) NEndpointGor(1) = StartpointGor(1) - Lkorodor * Sin(PI / 2 - AngleLine) NEndpointGor(2) = plineObjLocal.Elevation Set lineObj = ThisDrawing.ModelSpace.AddLine(NStartpointGor, NEndpointGor) CrossPoints = plineObjLocal.IntersectWith(lineObj, acExtendNone) lineObj.Delete If UBound(CrossPoints) > 1 Then For n = 0 To (UBound(CrossPoints)) objExcel.Worksheets("Poperechnik").Cells(i + BeginRow - 1, m) = CrossPoints(n) m = m + 1 Next n End If 'End If Next j objExcel.Worksheets("Poperechnik").Cells(i + BeginRow - 1, a12) = Coord((i - 1) * 2) objExcel.Worksheets("Poperechnik").Cells(i + BeginRow - 1, a13) = Coord((i - 1) * 2 + 1) Set TextObj = ThisDrawing.ModelSpace.AddText(i, StartpointGor, 2.5) Next i End Sub Private Sub SelectionDelete(SelectName As String) 'Зачистка существующих выборок Set objSSS = ThisDrawing.SelectionSets For Each objSS In objSSS If objSS.Name = SelectName Then ThisDrawing.SelectionSets.Item(SelectName).Delete Exit For End If Next End Sub Function SelectPolyline(nameSBR As String, LocalC1, LocalC2, LocalC3, LocalC4 As Double) As AcadSelectionSet Dim objSSLocal As AcadSelectionSet Dim gpCode(0 To 1) As Integer Dim dataValue(0 To 1) As Variant Dim groupCode, dataCode As Variant Dim corner1(0 To 2) As Double Dim corner2(0 To 2) As Double corner1(0) = LocalC1 corner1(1) = LocalC2 corner1(2) = 0 corner2(0) = LocalC3 corner2(1) = LocalC4 corner2(2) = 0 SelectionDelete nameSBR gpCode(0) = 0: dataValue(0) = "LWPolyline" gpCode(1) = 8: dataValue(1) = "LO" groupCode = gpCode dataCode = dataValue Set objSSLocal = ThisDrawing.SelectionSets.Add(nameSBR) objSSLocal.Select acSelectionSetCrossing, corner1, corner2, groupCode, dataValue Set SelectPolyline = objSSLocal End Function Function SelectPolylineAll(nameSBR As String) As AcadSelectionSet Dim objSSLocal As AcadSelectionSet Dim gpCode(0 To 1) As Integer Dim dataValue(0 To 1) As Variant Dim groupCode, dataCode As Variant SelectionDelete nameSBR gpCode(0) = 0: dataValue(0) = "LWPolyline" gpCode(1) = 8: dataValue(1) = "LO" groupCode = gpCode dataCode = dataValue Set objSSLocal = ThisDrawing.SelectionSets.Add(nameSBR) objSSLocal.Select acSelectionSetAll, , , groupCode, dataValue Set SelectPolylineAll = objSSLocal End Function Function NumPointNewPL(LocalPlineObj As AcadLWPolyline) As Integer Dim Coord As Variant Dim LenPL As Double NumPointNewPL = 0 Coord = LocalPlineObj.Coordinates For i = 1 To (UBound(LocalPlineObj.Coordinates) - 1) / 2 'Считывание координат вершин исходной Полинии LenPL = Sqr((Coord(2 * i - 2) - Coord(2 * i)) ^ 2 + (Coord(2 * i - 1) - Coord(2 * i + 1)) ^ 2) NumPointNewPL = NumPointNewPL + LenPL \ Step + 1 Next i End Function Public Sub CalculateNewPointPolyLine() Dim SizePL As Integer Dim LenPL As Double Dim AngleLine As Double Dim StartpointGor(0 To 2) As Double Dim EndpointGor(0 To 2) As Double Dim NewPointsPL(0 To 1) As Double Dim SelectName As String Dim PointPL() As Double Dim Coord As Variant Dim objSSLocal As AcadSelectionSet 'Зачистка выборок SelectionDelete "N1" SelectName = "N1" ThisDrawing.Utility.Prompt "Выбирете полилинию трассы для трассы" Set objSS = ThisDrawing.SelectionSets.Add(SelectName) objSS.SelectOnScreen Set plineObj = objSS.Item(0) SizePL = NumPointNewPL(plineObj) ReDim PointPL(2 * SizePL + 1) k = 0 Coord = plineObj.Coordinates 'Расчет точек в новой полилинии For i = 1 To (UBound(plineObj.Coordinates) - 1) / 2 'Создани линий по плану полилинии для определения угла AngleLine StartpointGor(0) = Coord(2 * i - 2) StartpointGor(1) = Coord(2 * i - 1) EndpointGor(0) = Coord(2 * i) EndpointGor(1) = Coord(2 * i + 1) LenPL = Sqr((Coord(2 * i - 2) - Coord(2 * i)) ^ 2 + (Coord(2 * i - 1) - Coord(2 * i + 1)) ^ 2) Set lineObj = ThisDrawing.ModelSpace.AddLine(StartpointGor, EndpointGor) AngleLine = lineObj.Angle 'Удаление линий по плану полилинии для определения угла AngleLine lineObj.Delete 'Расчет координат For j = 0 To LenPL \ Step PointPL(k) = StartpointGor(0) + j * Step * Cos(AngleLine) 'Координты X PointPL(k + 1) = StartpointGor(1) + j * Step * Sin(AngleLine) 'Координты Y k = k + 2 Next j Next i PointPL(2 * SizePL) = EndpointGor(0) PointPL(2 * SizePL + 1) = EndpointGor(1) Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(PointPL) End Sub Function NCount() As Integer 'Расчет числа заполненых строк Set objExcel = GetObject(, "Excel.Application") objExcel.Worksheets("Poperechnik").Activate objExcel.Worksheets("Poperechnik").Select NCount = 0 i = 5 Do While objExcel.Worksheets("Poperechnik").Cells(i, a12) <> "" NCount = NCount + 1 i = i + 1 Loop End Function Public Sub SortCoordinate() Dim VarLocal0, VarLocal1, VarLocal2 As Double Dim Min As Integer Dim count As Integer 'Ограничитель циклов Set objExcel = GetObject(, "Excel.Application") objExcel.Worksheets("Poperechnik").Activate objExcel.Worksheets("Poperechnik").Select For k = BeginRow To NCount + BeginRow count = a14 For i = a14 To a14 + A * 3 Step 3 If objExcel.Worksheets("Poperechnik").Cells(k, i) <> "" Then VarLocal0 = objExcel.Worksheets("Poperechnik").Cells(k, i) For j = count To a14 + A * 3 Step 3 If objExcel.Worksheets("Poperechnik").Cells(k, j) <> "" Then If VarLocal0 > objExcel.Worksheets("Poperechnik").Cells(k, j) Then VarLocal0 = objExcel.Worksheets("Poperechnik").Cells(k, j) Min = j End If Else Exit For End If Next j If Min <> 0 Then VarLocal1 = objExcel.Worksheets("Poperechnik").Cells(k, Min + 1) VarLocal2 = objExcel.Worksheets("Poperechnik").Cells(k, Min + 2) objExcel.Worksheets("Poperechnik").Cells(k, Min) = objExcel.Worksheets("Poperechnik").Cells(k, i) objExcel.Worksheets("Poperechnik").Cells(k, Min + 1) = objExcel.Worksheets("Poperechnik").Cells(k, i + 1) objExcel.Worksheets("Poperechnik").Cells(k, Min + 2) = objExcel.Worksheets("Poperechnik").Cells(k, i + 2) objExcel.Worksheets("Poperechnik").Cells(k, i) = VarLocal0 objExcel.Worksheets("Poperechnik").Cells(k, i + 1) = VarLocal1 objExcel.Worksheets("Poperechnik").Cells(k, i + 2) = VarLocal2 Min = 0 End If Else Exit For End If count = count + 3 Next i Next k End Sub Public Sub CalculateUklonGorizont() Dim LenPoint As Double Dim StartpointGor(0 To 2) As Double Dim EndpointGor(0 To 2) As Double Dim Uklon As Double Set objExcel = GetObject(, "Excel.Application") objExcel.Worksheets("Poperechnik").Activate objExcel.Worksheets("Poperechnik").Select Uklon = 0 For i = BeginRow To NCount + BeginRow - 1 If objExcel.Worksheets("Poperechnik").Cells(i, a14) <> "" Then For j = a14 To a14 + A * 3 Step 3 If objExcel.Worksheets("Poperechnik").Cells(i, j + 3) <> "" Then StartpointGor(0) = objExcel.Worksheets("Poperechnik").Cells(i, j) StartpointGor(1) = objExcel.Worksheets("Poperechnik").Cells(i, j + 1) StartpointGor(2) = objExcel.Worksheets("Poperechnik").Cells(i, j + 2) EndpointGor(0) = objExcel.Worksheets("Poperechnik").Cells(i, j + 3) EndpointGor(1) = objExcel.Worksheets("Poperechnik").Cells(i, j + 3 + 1) EndpointGor(2) = objExcel.Worksheets("Poperechnik").Cells(i, j + 3 + 2) LenPoint = Sqr((StartpointGor(0) - EndpointGor(0)) ^ 2 + (StartpointGor(1) - EndpointGor(1)) ^ 2) If LenPoint <> 0 Then If Abs(Uklon) < Abs(Round(Atn((EndpointGor(2) - StartpointGor(2)) / LenPoint) * 180 / PI, 1)) Then Uklon = Abs(Round(Atn((EndpointGor(2) - StartpointGor(2)) / LenPoint) * 180 / PI, 2)) End If End If Else Exit For End If Next j End If objExcel.Worksheets("Poperechnik").Cells(i, 7) = Uklon Uklon = 0 Next i End Sub Public Sub CalculatePolok() Dim Angle As Double Set objExcel = GetObject(, "Excel.Application") objExcel.Worksheets("Poperechnik").Activate objExcel.Worksheets("Poperechnik").Select For k = BeginRow To NCount + BeginRow Angle = TypePolkaSrezka(Abs(objExcel.Worksheets("Poperechnik").Cells(k, 7)), 5) If TypePolkaSrezka(Abs(objExcel.Worksheets("Poperechnik").Cells(k, 7)), 5) <> 0 Then objExcel.Worksheets("Poperechnik").Cells(k, 9) = Angle End If Next k End Sub Public Sub RazmetkaPolokDim() Dim Polka1, Polka2 As Double Dim mark As Long Dim PointDim1(0 To 2) As Double Dim PointDim2(0 To 2) As Double Dim Location(0 To 2) As Double PreparationLayers ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("_ЛО_Размеры") Set objExcel = GetObject(, "Excel.Application") objExcel.Worksheets("Poperechnik").Activate objExcel.Worksheets("Poperechnik").Select For k = BeginRow To NCount + BeginRow - 1 Polka1 = objExcel.Worksheets("Poperechnik").Cells(k, a9) Polka2 = objExcel.Worksheets("Poperechnik").Cells(k + 1, a9) If Polka1 = 0 And Polka2 <> 0 Then PointDim1(0) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a12) PointDim1(1) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a13) PointDim1(2) = 0 Location(0) = objExcel.Worksheets("Poperechnik").Cells(k, a12) Location(1) = objExcel.Worksheets("Poperechnik").Cells(k, a13) - 300 Location(2) = 0 End If If Polka1 <> 0 And Polka2 <> 0 And Polka1 <> Polka2 Then PointDim2(0) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a12) PointDim2(1) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a13) PointDim2(2) = 0 Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(PointDim1, PointDim2, Location) dimObj.TextColor = acCyan dimObj.TextOverride = "Тип полки по СПЛИТ " + CStr(Polka1) End If If Polka1 <> 0 And Polka2 <> 0 And Polka1 <> Polka2 Then PointDim1(0) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a12) PointDim1(1) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a13) PointDim1(2) = 0 Location(0) = objExcel.Worksheets("Poperechnik").Cells(k, a12) Location(1) = objExcel.Worksheets("Poperechnik").Cells(k, a13) - 300 Location(2) = 0 End If If Polka1 <> 0 And Polka2 = 0 Then PointDim2(0) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a12) PointDim2(1) = objExcel.Worksheets("Poperechnik").Cells(k + 1, a13) PointDim2(2) = 0 Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(PointDim1, PointDim2, Location) dimObj.TextColor = acCyan dimObj.TextOverride = "Тип полки по СПЛИТ " + CStr(Polka1) End If Next k End Sub Function TypePolkaSrezka(AlfaPop As Double, AlfaProd) As Double If AlfaProd >= 18 Then TypePolkaSrezka = 3.1 Else If AlfaPop >= 18 Then TypePolkaSrezka = 3.1 Else If AlfaProd < 15 Then If AlfaPop >= 8 And AlfaPop < 12 Then TypePolkaSrezka = 1.1 If AlfaPop >= 12 And AlfaPop < 18 Then TypePolkaSrezka = 2.1 End If If AlfaProd >= 15 Then If AlfaPop >= 8 And AlfaPop < 12 Then TypePolkaSrezka = 1.2 If AlfaPop >= 12 And AlfaPop < 18 Then TypePolkaSrezka = 2.2 End If End If End If End Function Function TypePolkaSrezkaText(AlfaPop As Double, AlfaProd) As String Dim Var As Variant 'Варианты полок срезок при продолльном уклоне менее 15 град. If AlfaProd < 15 Then 'If AlfaPop < 8 Then TypePolkaSrezka = "Не требуется срезок и полок" If AlfaPop >= 8 And AlfaPop < 12 Then TypePolkaSrezka = "Полка тип " + "" + "Попер.А=" + CStr(AlfaPop) + "град." + " " + "Прод.А=" + CStr(AlfaProd) + "град." If AlfaPop >= 12 And AlfaPop < 18 Then TypePolkaSrezka = "Полка II тип I. " + "Попер.А=" + CStr(AlfaPop) + "град." + " " + "Прод.А=" + CStr(AlfaProd) + "град." If AlfaPop >= 18 Then TypePolkaSrezka = "Срезка до 15 град. " + "Попер.А=" + CStr(AlfaPop) + "град." + " " + "Прод.А=" + CStr(AlfaProd) + "град." End If 'Варианты полок срезок при продолльном уклоне более 15 град. If AlfaProd >= 15 Then If AlfaPop < 8 Then TypePolkaSrezka = "Срезка. " + "Попер.А=" + AlfaPop + "град." + " " + "Прод.А=" + AlfaProd + "град." If AlfaPop >= 8 And AlfaPop < 12 Then TypePolkaSrezka = "Полка I тип II. " + "Попер.А=" + AlfaPop + "град." + " " + "Прод.А=" + AlfaProd + "град." If AlfaPop >= 12 And AlfaPop < 18 Then TypePolkaSrezka = "Полка II тип II. " + "Попер.А=" + AlfaPop + "град." + " " + "Прод.А=" + AlfaProd + "град." If AlfaPop >= 18 Then TypePolkaSrezka = "Срезка. " + "Попер.А=" + AlfaPop + "град." + " " + "Прод.А=" + AlfaProd + "град." End If End Function Private Sub NumberPiket() Dim VarStr As Variant For k = BeginRow To NCount + BeginRow - 1 objExcel.Worksheets("Poperechnik").Cells(k, a2) = k + 1 - BeginRow objExcel.Worksheets("Poperechnik").Cells(k, a3) = "ПК" VarStr = Split(BeginPiket, "+") objExcel.Worksheets("Poperechnik").Cells(k, a4) = (VarStr(0) * 100 + VarStr(1) + (k - BeginRow) * Step) \ StandartPiket objExcel.Worksheets("Poperechnik").Cells(k, a5) = "+" objExcel.Worksheets("Poperechnik").Cells(k, a6) = (VarStr(0) * 100 + VarStr(1) + (k - BeginRow) * Step) Mod StandartPiket Next k End Sub
PS: не понял как сюда подцепить файлы...но кому надо могу выслать исходники.