Перейти к содержанию

Дмитрий*

Пользователи
  • Публикаций

    5
  • Зарегистрирован

  • Посещение

Репутация

0 Обычный

Информация о Дмитрий*

  • Звание
    Новичок
  1. если который код выше то пожалуйста........ только там я добавил в свойства массива количество пролётов, но в программе переменных нет. балка пролётного строения.zip балка пролётного строения.zip
  2. файл какой для полилинии или стем кодом который я написал выше?
  3. Здравствуйте. Cпасибо за отклики. У меня другая тематика немножко. Мне для учёбы необходимо выполнить сложные научные инженерные расчёты в Excel с отображением полученных результатов в nanoCAD или в AutoCAD или .......... Я выбрал nanoCAD т.к у меня на версию 5.1 есть лицензия и для дальнейшей работы это тоже пригодится. И я написал небольшую программку для отображения балки в аксонометрии, но код этой маленькой программки получился длинный т.к балка отрисована обычными линиями. И для того чтобы в дальнейшем код не был громоздким необходимо отображать ломаную линию т.е полилинию , но из редактора VBA Excel отрисовка ломаной у меня не получается ни в nanoCAD, ни в AutoCAD хотя из автокадовского VBA ломаная с таким же кодом отрисовывается. Так что вот такие дела. А для учёбы приминим только Excel и приложение его VBA. Код для отрисовки балок : Sub Кнопка1_Нижполка() Set app = GetObject("", "nanoCAD.Application") app.Visible = True Set ThisDrawing = app.ActiveDocument Dim layer As AcadLayer Set layer = ThisDrawing.Layers.Add("Металлическая балка") layer.Color = 30 layer.Lineweight = acLnWt060 'толщина линии 0.60 мм ThisDrawing.ActiveLayer = layer Dim M1(2) As Double, M2(2) As Double Dim M3(2) As Double, M4(2) As Double, M5(2) As Double, M6(2) As Double, M7(2) As Double, M8(2) As Double, M9(2) As Double, M10(2) As Double, M11(2) As Double, M12(2) As Double Dim A, H, H1, B, C, N, V, O As Range Dim X1 As Double, X2 As Double, Y1 As Double, Y2 As Double Dim X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, Y3, Y4, Y5, Y6, Y7, Y8, Y9, Y10, Y11, Y12, Z1 Dim insert_point() As Double insert_point = ThisDrawing.Utility.GetPoint("0,0,0", "Укажите точку вставки объекта") Set A = Range("c4") 'начение диапазона присвоить переменной Set H = Range("E4"): Set B = Range("D4") Set H1 = Range("G4"): Set C = Range("F4") Set N = Range("C6"): Set O = Range("C8") V = A + O: Z1 = B: X1 = insert_point(0) 'координата по Х левой грани X2 = X1 + A 'координата по Х правой грани X3 = X1: X4 = X3 + A / 2 - C / 2: X5 = X3 + A / 2 + C / 2: X6 = X2: X7 = X1: X8 = X4 X9 = X5: X10 = X2: X11 = X1: X12 = X2: Y1 = insert_point(1) Y2 = Y1: Y3 = Y1 - H Y4 = Y3: Y5 = Y2 - H: Y6 = Y1 - H: Y7 = Y1 - H - H1 Y8 = Y7: Y9 = Y7: Y10 = Y7: Y11 = Y1 - 2 * H - H1: Y12 = Y11 M1(0) = X1: M1(1) = Y1: M2(0) = X2 M2(1) = Y2: M3(0) = X3: M3(1) = Y3 M4(0) = X4: M4(1) = Y4: M5(0) = X5 M5(1) = Y5: M6(0) = X6: M6(1) = Y6 M7(0) = X7: M7(1) = Y7: M8(0) = X8 M8(1) = Y8: M9(0) = X9: M9(1) = Y9 M10(0) = X10: M10(1) = Y10: M11(0) = X11 M11(1) = Y11: M12(0) = X12: M12(1) = Y12 Dim obj1 As Object, obj2 As Object, obj3 As Object, obj4 As Object, obj5 As Object, obj6 As Object Dim obj7 As Object, obj8 As Object, obj9 As Object, obj10 As Object, obj11 As Object, obj12 As Object Dim obj13 As Object, obj14 As Object, obj15 As Object, obj16 As Object, obj17 As Object, obj18 As Object Dim obj19 As Object, obj20 As Object, obj21 As Object, obj22 As Object, obj23 As Object, obj24 As Object Dim obj25 As Object, obj26 As Object, obj27 As Object, obj28 As Object, obj29 As Object, obj30 As Object Dim obj31 As Object, obj32 As Object, obj33 As Object, obj34 As Object, obj35 As Object, obj36 As Object Dim obj37 As Object, obj38 As Object, obj39 As Object, obj40 As Object Set obj1 = ThisDrawing.ModelSpace.AddLine(M1, M2): Set obj2 = ThisDrawing.ModelSpace.AddLine(M1, M3) Set obj3 = ThisDrawing.ModelSpace.AddLine(M3, M6): Set obj4 = ThisDrawing.ModelSpace.AddLine(M4, M5) Set obj5 = ThisDrawing.ModelSpace.AddLine(M2, M6): Set obj6 = ThisDrawing.ModelSpace.AddLine(M5, M6) Set obj7 = ThisDrawing.ModelSpace.AddLine(M4, M8): Set obj8 = ThisDrawing.ModelSpace.AddLine(M5, M9) Set obj9 = ThisDrawing.ModelSpace.AddLine(M9, M10): Set obj10 = ThisDrawing.ModelSpace.AddLine(M7, M10) Set obj11 = ThisDrawing.ModelSpace.AddLine(M8, M9): Set obj12 = ThisDrawing.ModelSpace.AddLine(M7, M11) Set obj13 = ThisDrawing.ModelSpace.AddLine(M10, M12): Set obj14 = ThisDrawing.ModelSpace.AddLine(M11, M12) Dim M13(0 To 2) As Double, M14(0 To 2) As Double, M15(0 To 2) As Double, M16(0 To 2) As Double, M17(0 To 2) As Double, M18(0 To 2) As Double, M19(0 To 2) As Double, M20(0 To 2) As Double, M21(0 To 2) As Double, M22(0 To 2) As Double, M23(0 To 2) As Double, M24(0 To 2) As Double M13(0) = X1: M13(1) = Y1: M13(2) = Z1 M14(0) = X2: M14(1) = Y2: M14(2) = Z1 M15(0) = X3: M15(1) = Y3: M15(2) = Z1 M16(0) = X4: M16(1) = Y4: M16(2) = Z1 M17(0) = X5: M17(1) = Y5: M17(2) = Z1 M18(0) = X6: M18(1) = Y6: M18(2) = Z1 M19(0) = X7: M19(1) = Y7: M19(2) = Z1 M20(0) = X8: M20(1) = Y8: M20(2) = Z1 M21(0) = X9: M21(1) = Y9: M21(2) = Z1 M22(0) = X10: M22(1) = Y10: M22(2) = Z1 M23(0) = X11: M23(1) = Y11: M23(2) = Z1 M24(0) = X12: M24(1) = Y12: M24(2) = Z1 Set obj15 = ThisDrawing.ModelSpace.AddLine(M13, M14): Set obj16 = ThisDrawing.ModelSpace.AddLine(M13, M15) Set obj17 = ThisDrawing.ModelSpace.AddLine(M15, M18): Set obj18 = ThisDrawing.ModelSpace.AddLine(M16, M17) Set obj19 = ThisDrawing.ModelSpace.AddLine(M14, M18): Set obj20 = ThisDrawing.ModelSpace.AddLine(M17, M18) Set obj21 = ThisDrawing.ModelSpace.AddLine(M16, M20): Set obj22 = ThisDrawing.ModelSpace.AddLine(M17, M21) Set obj23 = ThisDrawing.ModelSpace.AddLine(M19, M22): Set obj24 = ThisDrawing.ModelSpace.AddLine(M20, M21) Set obj25 = ThisDrawing.ModelSpace.AddLine(M19, M23): Set obj26 = ThisDrawing.ModelSpace.AddLine(M22, M24) Set obj27 = ThisDrawing.ModelSpace.AddLine(M21, M22): Set obj28 = ThisDrawing.ModelSpace.AddLine(M23, M24) Set obj29 = ThisDrawing.ModelSpace.AddLine(M1, M13): Set obj30 = ThisDrawing.ModelSpace.AddLine(M2, M14) Set obj31 = ThisDrawing.ModelSpace.AddLine(M3, M15): Set obj32 = ThisDrawing.ModelSpace.AddLine(M6, M18) Set obj33 = ThisDrawing.ModelSpace.AddLine(M4, M16): Set obj34 = ThisDrawing.ModelSpace.AddLine(M5, M17) Set obj35 = ThisDrawing.ModelSpace.AddLine(M7, M19): Set obj36 = ThisDrawing.ModelSpace.AddLine(M8, M20) Set obj37 = ThisDrawing.ModelSpace.AddLine(M9, M21): Set obj38 = ThisDrawing.ModelSpace.AddLine(M10, M22) Set obj39 = ThisDrawing.ModelSpace.AddLine(M11, M23): Set obj40 = ThisDrawing.ModelSpace.AddLine(M12, M24) Dim robj1 As Variant, robj2 As Variant, robj3 As Variant, robj4 As Variant, robj5 As Variant, robj6 As Variant Dim robj7 As Variant, robj8 As Variant, robj9 As Variant, robj10 As Variant, robj11 As Variant, robj12 As Variant Dim robj13 As Variant, robj14 As Variant, robj15 As Variant, robj16 As Variant, robj17 As Variant, robj18 As Variant Dim robj19 As Variant, robj20 As Variant, robj21 As Variant, robj22 As Variant, robj23 As Variant, robj24 As Variant Dim robj25 As Variant, robj26 As Variant, robj27 As Variant, robj28 As Variant, robj29 As Variant, robj30 As Variant Dim robj31 As Variant, robj32 As Variant, robj33 As Variant, robj34 As Variant, robj35 As Variant, robj36 As Variant Dim robj37 As Variant, robj38 As Variant, robj39 As Variant, robj40 As Variant Dim nOfRows As Long, nOfColumns As Long, nOfLevels As Long, DistRows As Double, DistCols As Double, DistLevels As Double nOfRows = 1: nOfColumns = N nOfLevels = 1: DistRows = 0 DistCols = V: DistLevels = 1 robj1 = obj1.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj2 = obj2.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj3 = obj3.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj4 = obj4.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj5 = obj5.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj6 = obj6.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj7 = obj7.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj8 = obj8.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj9 = obj9.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj10 = obj10.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj11 = obj11.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj12 = obj12.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj13 = obj13.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj14 = obj14.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj15 = obj15.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj16 = obj16.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj17 = obj17.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj18 = obj18.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj19 = obj19.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj20 = obj20.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj21 = obj21.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj22 = obj22.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj23 = obj23.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj24 = obj24.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj25 = obj25.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj26 = obj26.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj27 = obj27.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj28 = obj28.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj29 = obj29.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj30 = obj30.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj31 = obj31.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj32 = obj32.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj33 = obj33.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj34 = obj34.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj35 = obj35.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj36 = obj36.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj37 = obj37.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj38 = obj38.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj39 = obj39.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) robj40 = obj40.ArrayRectangular(nOfRows, nOfColumns, nOfLevels, DistRows, DistCols, DistLevels) Dim NewDirection(0 To 2) As Double NewDirection(0) = 0.5: NewDirection(1) = 0.5: NewDirection(2) = 13 ThisDrawing.ActiveViewport.Direction = NewDirection ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport End Sub Балка .dwg
  4. Sub Acad3DPolyline() Set app = GetObject("", "nanoCAD.Application") ' app.Visible = True Set ThisDrawing = app.ActiveDocument Dim robj As Object Set robj = ThisDrawing.PaperSpace 'Variant (array of doubles); input-only 'An array of 3D WCS coordinates. The polyline will be created according to the order of the coordinates in the array. The number of elements in the array must be a multiple of three. (Three elements define a single coordinate.) 'массив трёхмерный с внесением записей координат в память. Полилиния должна быть создана из элементов в определённом порядке равными по рангу в массиве. Число элементов в теле массива должно состоять из структуры координат с тремя значениями (x,y,z)(Три элемента определяют одно место положение). ' Variant (array of doubles); input-only (вариант(массив двойной точности); простой ввод) Dim point(0 To 9) As Double point(1) = 0#: point(2) = 0#: point(3) = 0# point(4) = 10#: point(5) = 10#: point(6) = 0# point(7) = 23#: point(8) = 22#: point(9) = 0# robj = Object.ThisDrawing.PaperSpace.Acad3DPolyline(point) End Sub Подскажите пожалуйста где ошибка по отрисовке полилинии в VBA Excel версия nanoCAD 5/1
  5. Здравствуйте! Подскажите пожалуйста как отрисовать полилинию в версии 5.1 nanocad через VBA Excel?
  6. отрисовка полилинии в нанокад 5.1

×
×
  • Создать...