Способы вычислить точки привязки размеров, ограничения VBA.

Автор Тема: Способы вычислить точки привязки размеров, ограничения VBA.  (Прочитано 588 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Оффлайн ВасилийАвтор темы

  • ADN OPEN
  • Сообщений: 26
  • Карма: 0
Цитировать
Я дал заготовку кода. Измени путь к файлу. Возможно у тебя туда нет доступа.

Снимаю шляпу, за свою не внимательность. Преклоняю колено. Действительно на домашнем компьютере диски N, M, F.
А я уже руки опустил.
Код - Visual Basic [Выбрать]
  1.  Dim flag As Boolean
  2.  flag = True
  3.  Do While flag
  4.     If Len(Dir$(FilePathAndName)) > 0 Then
  5.        'MsgBox ("Файл существует!")
  6.       flag = False
  7.     Else
  8.        'MsgBox ("Файл не найден...")
  9.        Start = Timer
  10.         Do While Timer < Start + 0.5 '0.5 = полсекунды
  11.            DoEvents
  12.         Loop
  13.     End If
  14.  Loop
  15.  

Спасибо за код секции, я тоже использовал аналогичную конструкцию для определения готовности файла.

За мной теперь доработка кода, с целью получения искомых точек, для того чтоб предложить Вариант 4 решения этой задачи.

Оффлайн Владимир Шу

  • ADN Club
  • ****
  • Сообщений: 375
  • Карма: 73
Так ответ то уже готов... я слегка подправил код...
Извините, вам запрещён просмотр содержимого спойлеров.

и теперь результат такой:

И ту уже совсем все просто...
ЗЫ.
Мне просто интересно было до аннотативности добраться, что в VBA проблемно...
т.е. узнать о том что объект аннотативен можно было посмотрев на соответствующий словарь, а вот значение... значение через dxf... в принципе возможно.

Оффлайн ВасилийАвтор темы

  • ADN OPEN
  • Сообщений: 26
  • Карма: 0
Я до пилю, спасибо за потраченное на меня время. Хочу дать ответ по имени темы
"Точки привязки размеров", это функция которая вернёт именно StartPoint,
EndPoint и location. Вариант 4 от начала темы

Оффлайн ВасилийАвтор темы

  • ADN OPEN
  • Сообщений: 26
  • Карма: 0
Аннотативность для меня такой же секрет, для этого я и вычисляю точки, чтоб потом выставить масштаб и перестроить размеры. Текущий масштаб применяется как аннотативный у этих размеров. Но увы скорей всего после этого проекта я на VBA больше писать не буду, слишком много свойств которые не доступны. И приходится придумывать вот такие способы, которые мы обсуждаем в этой теме

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 7669
  • Карма: 902
  • Рыцарь ObjectARX
  • Skype: rivilis
Но увы скорей всего после этого проекта я на VBA больше писать не буду, слишком много свойств которые не доступны.
Правильный вывод. Тем более, что всё что можно в VBA можно и в .NET. Причем рекомендую C# а не VB.NET - как минимум примеров больше.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн ВасилийАвтор темы

  • ADN OPEN
  • Сообщений: 26
  • Карма: 0
Вариант 4. Получение точек из dxf файла
Благодарю за идею, участие и терпение Александра Ривилиса и Владимира Шу за парсинг, до которого я сам не дошёл.

Код - Visual Basic [Выбрать]
  1. '
  2.  
  3. Function GetPointAcDimrotated(returnObj As AcadDimRotated)
  4.       Dim D As AcadEntity
  5.       Dim Tp As Variant
  6.       Dim VariantArr() As Variant
  7.       Dim k As Long
  8.       Dim ArrDxf As Boolean
  9.       Dim flagArr As Boolean
  10.       Dim ArrDimPoint() As Variant
  11.       Dim Codedxf As Variant
  12.       Dim CodeValue As Variant
  13.       Dim arrRes() As String
  14.       Dim startPnt(0 To 2), endPnt(0 To 2), location(0 To 2) As Variant
  15.       Dim ResArrPoint(0 To 2) As Variant
  16.       Dim Start As Double
  17.       Dim FileName_Dxf As String
  18.       Dim i As Integer
  19.       Dim str As String
  20.       Dim flag As Boolean
  21.       Dim FilePathAndName As String
  22.       Dim InputData
  23.       Dim reading As Boolean
  24.       Dim AcDimensionPropTemp As New Collection
  25.       Dim lineNumber As Integer
  26.      
  27.       ArrDxf = False
  28.       flag = True
  29.       FileName_Dxf = ThisDrawing.GetVariable("DWGPREFIX") & "Dimdxf.dxf"
  30.       FileName_Dxf = Replace(FileName_Dxf, "\", "\\")
  31.       str = "(command ""_dxfout"" """ & FileName_Dxf & """ ""_O""" & " (handent """ & returnObj.Handle & """)" & " """" """") "
  32.       Application.ActiveDocument.SendCommand (str)
  33.      
  34. 'Подождем пока файлик появится
  35.  
  36.       FilePathAndName = FileName_Dxf
  37.  Do While flag
  38.     If Len(Dir$(FilePathAndName)) > 0 Then
  39.        'MsgBox ("Файл существует!")
  40.       flag = False
  41.     Else
  42.        'MsgBox ("Файл не найден...")
  43.        Start = Timer
  44.         Do While Timer < Start + 0.5 '0.5 = полсекунды
  45.            DoEvents
  46.         Loop
  47.     End If
  48.  Loop
  49. reading = False
  50.  
  51. On Error GoTo Exit1
  52. Open FilePathAndName For Input As #4
  53. Do While Not EOF(4)
  54.     Line Input #4, InputData
  55.         If Trim(InputData) = "ENTITIES" Then
  56.           reading = True
  57.         End If
  58.         If reading And Trim(InputData) = "ENDSEC" Then
  59.            Exit Do
  60.         End If
  61.         If reading Then
  62.             AcDimensionPropTemp.Add Item:=InputData, key:=CStr(lineNumber)
  63.         End If
  64.         lineNumber = lineNumber + 1
  65. Loop
  66.  k = -1
  67. For i = 3 To AcDimensionPropTemp.Count Step 2
  68.   ArrDxf = True
  69.   k = k + 1
  70.   ReDim Preserve VariantArr(k)
  71.              VariantArr(k) = (Chr(10) & AcDimensionPropTemp(i - 1) & "->" & AcDimensionPropTemp(i))
  72.    
  73. Next
  74. k = -1
  75. If ArrDxf Then
  76.  For i = 0 To UBound(VariantArr)
  77.   arrRes = Split(VariantArr(i), "->")
  78.    Codedxf = arrRes(0)
  79.    CodeValue = arrRes(1)
  80.    
  81.     ' определение startPnt
  82.    If Codedxf = 13 Then
  83.        startPnt(0) = CodeValue
  84.        flagArr = True
  85.      k = k + 1
  86.        ReDim Preserve ArrDimPoint(k)
  87.        ArrDimPoint(k) = startPnt(0)
  88.    End If
  89.    If Codedxf = 23 Then
  90.        startPnt(1) = CodeValue
  91.        flagArr = True
  92.      k = k + 1
  93.        ReDim Preserve ArrDimPoint(k)
  94.        ArrDimPoint(k) = startPnt(1)
  95.    End If
  96.    If Codedxf = 33 Then
  97.        startPnt(2) = CodeValue
  98.        flagArr = True
  99.      k = k + 1
  100.        ReDim Preserve ArrDimPoint(k)
  101.        ArrDimPoint(k) = startPnt(2)
  102.    End If
  103.    
  104.     ' определение endPnt
  105.   If Codedxf = 14 Then
  106.        endPnt(0) = CodeValue
  107.        flagArr = True
  108.      k = k + 1
  109.        ReDim Preserve ArrDimPoint(k)
  110.        ArrDimPoint(k) = endPnt(0)
  111.    End If
  112.    If Codedxf = 24 Then
  113.        endPnt(1) = CodeValue
  114.        flagArr = True
  115.      k = k + 1
  116.        ReDim Preserve ArrDimPoint(k)
  117.        ArrDimPoint(k) = endPnt(1)
  118.    End If
  119.    If Codedxf = 34 Then
  120.        endPnt(2) = CodeValue
  121.        flagArr = True
  122.      k = k + 1
  123.        ReDim Preserve ArrDimPoint(k)
  124.        ArrDimPoint(k) = endPnt(2)
  125.   End If
  126.  
  127.   ' определение location
  128.  If Codedxf = 10 Then
  129.        location(0) = CodeValue
  130.        flagArr = True
  131.      k = k + 1
  132.        ReDim Preserve ArrDimPoint(k)
  133.        ArrDimPoint(k) = location(0)
  134.    End If
  135.    If Codedxf = 20 Then
  136.        location(1) = CodeValue
  137.        flagArr = True
  138.      k = k + 1
  139.        ReDim Preserve ArrDimPoint(k)
  140.        ArrDimPoint(k) = location(1)
  141.    End If
  142.    If Codedxf = 30 Then
  143.        location(2) = CodeValue
  144.        flagArr = True
  145.      k = k + 1
  146.        ReDim Preserve ArrDimPoint(k)
  147.        ArrDimPoint(k) = location(2)
  148.   End If
  149.  Next
  150.  If flagArr Then
  151.     If UBound(ArrDimPoint) = 8 Then
  152.         ResArrPoint(0) = startPnt
  153.         ResArrPoint(1) = endPnt
  154.         ResArrPoint(2) = location
  155.         GetPointAcDimrotated = ResArrPoint
  156.         Debug.Print startPnt(0), startPnt(1), startPnt(2)
  157.         Debug.Print endPnt(0), endPnt(1), endPnt(2)
  158.         Debug.Print location(0), location(1), location(2)
  159.         Else
  160.         GoTo Exit1
  161.     End If
  162.     Else
  163.     GoTo Exit1
  164.  End If
  165. End If
  166. Exit1:
  167. Close #4
  168.      
  169.        
  170. End Function
  171.  

Оффлайн Владимир Шу

  • ADN Club
  • ****
  • Сообщений: 375
  • Карма: 73
ИМХО, Вы несколько перемудрили... Все проще.

Первые 3 строчки кода (у Вас это примерно 66-73 строки) нужно было заменить просто созданием  и заполнением словаря (с 8 по 15 строки)
Код - Visual Basic [Выбрать]
  1. 'For i = 3 To AcDimensionPropTemp.Count Step 2
  2. ' ThisDrawing.Utility.Prompt (Chr(10) & AcDimensionPropTemp(i - 1) & " -> " & AcDimensionPropTemp(i))
  3. 'Next
  4.    
  5. 'To add the reference to your VBA project, go to the VB Editor,
  6. 'and select Tools --> References from the menu.  Select Microsoft Scripting Runtime
  7. 'from the list of installed libraries, and click OK.
  8. Dim MyDictionary As Object
  9. Set MyDictionary = CreateObject("Scripting.Dictionary")
  10.  
  11. For i = 3 To AcDimensionPropTemp.Count Step 2
  12.     With MyDictionary
  13.         If Not .Exists(Trim(CStr(AcDimensionPropTemp(i - 1)))) Then .Add Trim(CStr(AcDimensionPropTemp(i - 1))), AcDimensionPropTemp(i)
  14.     End With
  15. Next
  16.        
  17. 'For Each i In MyDictionary.Keys
  18. ' ThisDrawing.Utility.Prompt (Chr(10) & i & " -> " & MyDictionary.Item(i))
  19. 'Next
  20.  

И данные забирать по значению dxf кодов, как то так:
Код - Visual Basic [Выбрать]
  1. Dim xCoord As String: sd = MyDictionary.Item("10")
  2.    
  3.     Dim p1(2) As Double
  4.     p1(0) = Val(MyDictionary.Item("10"))
  5.     p1(1) = Val(MyDictionary.Item("20"))
  6.     p1(2) = Val(MyDictionary.Item("30"))
  7.  

Оффлайн ВасилийАвтор темы

  • ADN OPEN
  • Сообщений: 26
  • Карма: 0
С учётом правки предложенной  Владимиром Шу

Код - Visual Basic [Выбрать]
  1. '
  2. Function GetPointAcDimrotated(returnObj As AcadDimRotated)
  3.  
  4.  
  5.       Dim startPnt(0 To 2), endPnt(0 To 2), location(0 To 2) As Variant
  6.       Dim Start As Double
  7.       Dim FileName_Dxf As String
  8.       Dim i As Integer
  9.       Dim str As String
  10.       Dim flag As Boolean
  11.       Dim FilePathAndName As String
  12.       Dim InputData
  13.       Dim reading As Boolean
  14.       Dim AcDimensionPropTemp As New Collection
  15.       Dim lineNumber As Integer
  16.       Dim Tr As Variant
  17.       Dim ResArrPoint(0 To 2) As Variant
  18.       flag = True
  19.       FileName_Dxf = ThisDrawing.GetVariable("DWGPREFIX") & "Dimdxf33.dxf"
  20.       FileName_Dxf = Replace(FileName_Dxf, "\", "\\")
  21.       str = "(command ""_dxfout"" """ & FileName_Dxf & """ ""_O""" & " (handent """ & returnObj.Handle & """)" & " """" """") "
  22.       Application.ActiveDocument.SendCommand (str)
  23.      
  24. 'Подождем пока файлик появится
  25.  
  26.       FilePathAndName = FileName_Dxf
  27.  Do While flag
  28.     If Len(Dir$(FilePathAndName)) > 0 Then
  29.        'MsgBox ("Файл существует!")
  30.       flag = False
  31.     Else
  32.        'MsgBox ("Файл не найден...")
  33.        Start = Timer
  34.         Do While Timer < Start + 0.5 '0.5 = полсекунды
  35.            DoEvents
  36.         Loop
  37.     End If
  38.  Loop
  39. reading = False
  40.  
  41. 'On Error GoTo Exit1
  42. Open FilePathAndName For Input As #4
  43. Do While Not EOF(4)
  44.     Line Input #4, InputData
  45.         If Trim(InputData) = "ENTITIES" Then
  46.           reading = True
  47.         End If
  48.         If reading And Trim(InputData) = "ENDSEC" Then
  49.            Exit Do
  50.         End If
  51.         If reading Then
  52.             AcDimensionPropTemp.Add Item:=InputData, key:=CStr(lineNumber)
  53.         End If
  54.         lineNumber = lineNumber + 1
  55. Loop
  56.  
  57. Dim MyDictionary As Object
  58. Set MyDictionary = CreateObject("Scripting.Dictionary")
  59.  
  60. For i = 3 To AcDimensionPropTemp.Count Step 2
  61.     With MyDictionary
  62.         If Not .Exists(Trim(CStr(AcDimensionPropTemp(i - 1)))) Then .Add Trim(CStr(AcDimensionPropTemp(i - 1))), AcDimensionPropTemp(i)
  63.     End With
  64. Next
  65.    
  66.    startPnt(0) = MyDictionary.Item("13")
  67.    startPnt(1) = MyDictionary.Item("23")
  68.    startPnt(2) = MyDictionary.Item("33")
  69.  
  70.    endPnt(0) = MyDictionary.Item("14")
  71.    endPnt(1) = MyDictionary.Item("24")
  72.    endPnt(2) = MyDictionary.Item("34")
  73.  
  74.    location(0) = MyDictionary.Item("10")
  75.    location(1) = MyDictionary.Item("20")
  76.    location(2) = MyDictionary.Item("30")
  77.    ResArrPoint(0) = startPnt
  78.    ResArrPoint(1) = endPnt
  79.    ResArrPoint(2) = location
  80.    GetPointAcDimrotated = ResArrPoint
  81.  
  82. Exit1:
  83. Close #4
  84. End Function
  85.  

Единственное если делаю строку численной
Код - Visual Basic [Выбрать]
  1. '
  2. Val(MyDictionary.Item("13"))
  3.  
размер отстраивается некорректно. Наверно связанно с разделителем численной части в системе