• Marat
  • Восстановленный участник
  • На форуме с 23 сентября 2006г.
  • Сообщений: 5
  • Спасибо: 0

Тема: Создание и подсчет спецификации арматурного чертежа

Как считать иформацию с выделеной линии (слой,длина), создать тблицу(позиция,диаметр,длина,вес,общий вес).Помогите пожалйста.Я при руном заполнении и подсчете подескаю много ошибок, к тому же отнимает много времени.

  • LeonidSN
  • Активный участник
  • На форуме с 30 мая 2005г.
  • Сообщений: 1,480
  • Спасибо: 5

Re: Создание и подсчет спецификации арматурного чертежа

> Marat
Ну чем тут можно помочь? Существует множество специализированных программ и систем в этой области и все они коммерческие. Во всяком случае, загляни на этот сайт:
http://dwg.ru/

  • Marat
  • Восстановленный участник
  • На форуме с 23 сентября 2006г.
  • Сообщений: 5
  • Спасибо: 0

Re: Создание и подсчет спецификации арматурного чертежа

Спасибо что откликнулся. Но я все равно попытаюсь написать для себя такую программу,конкретно для своей фирмы. Потому-что интересно разoбобратся с VBA.

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Создание и подсчет спецификации арматурного чертежа

> Marat
Тут должны подойти расширенные данные,
где ты можешь задать все твои параметры
для каждой линии
Смотри поиск по форуму
Куча примеров
~'J'~

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Создание и подсчет спецификации арматурного чертежа

> Marat
Можно записать расширенные данные для выделенных
линий так:
(для вычислений исходя из погонного метра арматуры
нужно прописать отдельную функцию и заменить
переменную dest)

Option Explicit
Sub ArmXDataSet()
Dim oSset As AcadSelectionSet
Dim oEnt
Dim objLine As AcadLine
Dim fcode(0) As Integer
Dim fdata(0) As Variant
Dim dxfcode, dxfdata
Dim i As Integer
Dim setName As String
     fcode(0) = 0
     fdata(0) = "LINE"
     dxfcode = fcode
     dxfdata = fdata
     setName = "$LineSet$"
For i = 0 To ThisDrawing.SelectionSets.Count - 1
     If ThisDrawing.SelectionSets.Item(i).Name = setName Then
     ThisDrawing.SelectionSets.Item(i).Delete
     Exit For
     End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.SelectOnScreen dxfcode, dxfdata
    Dim DataType(0 To 5) As Integer
    Dim Data(0 To 5) As Variant
    Dim appName As String
    Dim dest As Double
    Dim n As Integer
    n = 1
    dest = CDbl(InputBox("Удельный вес арматуры:", "Ввод данных"))
    MsgBox "Выбрано: " & CStr(oSset.Count) & " линий"
For Each oEnt In oSset
    Set objLine = oEnt
    DataType(0) = 1001: Data(0) = "Aramature Specs"
    DataType(1) = 1000: Data(1) = "Pos. #" & CStr(n)
    DataType(2) = 1003: Data(2) = objLine.Layer ' слои вида: "Pipe 50" (для цилиндров диаметром 50) и т.д.
    DataType(3) = 1041: Data(3) = objLine.Length
    DataType(4) = 1040: Data(4) = CDbl(Right(objLine.Layer, 2)) 'диаметр
    DataType(5) = 1040: Data(5) = CDbl(objLine.Length) * CDbl(Right(objLine.Layer, 2)) + dest
    objLine.SetXData DataType, Data
    n = n + 1
Next
ThisDrawing.Regen acActiveViewport
End Sub

Прочитать расширенные данные можно так:
(для отдельной линии)

Sub Ch_GetXData()
    Dim pickObj As AcadEntity
    Dim varPt As Variant
    Dim xdataOut As Variant
    Dim xtypeOut As Variant
    Dim i As Integer
    ThisDrawing.Utility.GetEntity pickObj, varPt, "Select line:"
    pickObj.GetXData "", xtypeOut, xdataOut
    For i = LBound(xdataOut) To UBound(xdataOut)
    MsgBox CStr(xdataOut(i))
    Next
End Sub

~'J'~

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Создание и подсчет спецификации арматурного чертежа

> Marat
Так можно получить данные и записать в таблицу:

Sub ArmXDataGet()
Dim oSset As AcadSelectionSet
Dim oEnt
Dim objLine As AcadLine
Dim fcode(0) As Integer
Dim fdata(0) As Variant
Dim dxfcode, dxfdata
Dim i As Integer
Dim setName As String
Dim xdataOut As Variant
Dim xtypeOut As Variant
     fcode(0) = 0
     fdata(0) = "LINE"
     dxfcode = fcode
     dxfdata = fdata
     setName = "$LineSet$"
     On Error GoTo Err_Msg
For i = 0 To ThisDrawing.SelectionSets.Count - 1
     If ThisDrawing.SelectionSets.Item(i).Name = setName Then
     ThisDrawing.SelectionSets.Item(i).Delete
     Exit For
     End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.SelectOnScreen dxfcode, dxfdata
    Dim DataType(0 To 5) As Integer
    Dim Data(0 To 5) As Variant
    Dim appName As String
    MsgBox "Выбрано: " & CStr(oSset.Count) & " линий"
Dim oTable As AcadTable
Dim insPt
Dim iRows As Long, iCols As Long
Dim rowHgt As Double, colWid As Double
Dim m As Long, n As Long
Dim tmpStr As String
Dim sumWeight As Double
insPt = ThisDrawing.Utility.GetPoint(, "Pick table insertion point:")
iRows = oSset.Count + 3
iCols = 4
rowHgt = 1.5
colWid = 21.5
Set oTable = ThisDrawing.ModelSpace.AddTable(insPt, iRows, iCols, rowHgt, colWid)
m = 0
n = 0
tmpStr = "Спецификация"
oTable.SetText m, n, tmpStr
m = 1
Dim headArr
headArr = Array("Позиция", "Длина", "Диаметр", "Вес")
For n = 0 To UBound(headArr)
tmpStr = headArr(n)
oTable.SetText m, n, tmpStr
Next n
m = 2
n = 0
sumWeight = 0#
For Each oEnt In oSset
Set objLine = oEnt
   objLine.GetXData "", xtypeOut, xdataOut
With oTable
tmpStr = xdataOut(1)
.SetText m, n, tmpStr
n = n + 1
tmpStr = ThisDrawing.Utility.RealToString(xdataOut(3), acDecimal, 2)
.SetText m, n, tmpStr
n = n + 1
tmpStr = xdataOut(4)
.SetText m, n, tmpStr
n = n + 1
sumWeight = sumWeight + xdataOut(5)
tmpStr = ThisDrawing.Utility.RealToString(xdataOut(5), acDecimal, 2)
.SetText m, n, tmpStr
n = n + 1
End With
m = m + 1
n = 0
Next
n = 2
tmpStr = "Общий вес:"
oTable.SetText m, n, tmpStr
n = n + 1
tmpStr = ThisDrawing.Utility.RealToString(sumWeight, acDecimal, 2)
oTable.SetText m, n, tmpStr
oTable.RecomputeTableBlock True
ThisDrawing.Regen acActiveViewport
Err_Msg:
End Sub

~'J'~

  • Marat
  • Восстановленный участник
  • На форуме с 23 сентября 2006г.
  • Сообщений: 5
  • Спасибо: 0

Re: Создание и подсчет спецификации арматурного чертежа

Спасибо всем. Я еще в самом начале изучения VBA.
Обезательно попробую применить все на практике.
Начну прямо сейчас.Сообщу о результатах.

  • Marat
  • Восстановленный участник
  • На форуме с 23 сентября 2006г.
  • Сообщений: 5
  • Спасибо: 0

Re: Создание и подсчет спецификации арматурного чертежа

Fatty грамадное тебе спасибо я просто готов прыгать от счастья. Все коды работают. Я попробую написать код, чтоб не вбивать удельный вес (в функцию) в ручную, а чтоб он сам считал его в звависимости от LayerName по известной формуле (площадь поперечного сечения на удельный вес металла).

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Создание и подсчет спецификации арматурного чертежа

> Marat
Я не уверен, но по-моему использование веса
погонного метра даст более точный результат
Такую функцию удобней всего написать с использованием Select Case...
Успехов
~'J'~

  • Marat
  • Восстановленный участник
  • На форуме с 23 сентября 2006г.
  • Сообщений: 5
  • Спасибо: 0

Re: Создание и подсчет спецификации арматурного чертежа

Я немного изменил твой код, но он тоже работает.
Честно говоря я не понял как написать функцию о которой ты говоришь.По этому я написал так:

Option Explicit
Sub ArmXDataSet()
Dim oSset As AcadSelectionSet
Dim oEnt
Dim objLine As AcadLine
Dim fcode(0) As Integer
Dim fdata(0) As Variant
Dim dxfcode, dxfdata
Dim i As Integer
Dim setName As String
     fcode(0) = 0
     fdata(0) = "LINE"
     dxfcode = fcode
     dxfdata = fdata
     setName = "$LineSet$"
     For i = 0 To ThisDrawing.SelectionSets.Count - 1
     If ThisDrawing.SelectionSets.Item(i).Name = setName Then
     ThisDrawing.SelectionSets.Item(i).Delete
     Exit For
     End If
Next i
Set oSset = ThisDrawing.SelectionSets.Add(setName)
oSset.SelectOnScreen dxfcode, dxfdata
    Dim DataType(0 To 5) As Integer
    Dim Data(0 To 5) As Variant
    Dim appName As String
    Dim dest As Double
    Dim n As Integer
    n = 1
    'dest = CDbl(InputBox("Óäåëüíûé âåñ àðìàòóðû:", "Ââîä äàííûõ "))
    MsgBox "Âûáðàíî: " & CStr(oSset.Count) & " ëèíèé"
For Each oEnt In oSset
    Set objLine = oEnt
    DataType(0) = 1001: Data(0) = "Aramature Specs"
    DataType(1) = 1000: Data(1) = "Pos. #" & CStr(n)
    DataType(2) = 1003: Data(2) = objLine.Layer
    ' ñëîè âèäà:"Pipe 50" (äëÿ öèëèíäðîâ äèàìåòðîì 50) è ò.ä.
    DataType(3) = 1041: Data(3) = objLine.Length
    DataType(4) = 1040: Data(4) = CDbl(Right(objLine.Layer, 2))
    'äèàìåòð
    dest = CDbl(Right(objLine.Layer, 2)) * CDbl(Right(objLine.Layer, 2)) * 3.14 / 4 * 0.00000785
    DataType(5) = 1040: Data(5) = dest
    objLine.SetXData DataType, Data
    n = n + 1
Next
ThisDrawing.Regen acActiveViewport
End Sub