| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA AutoCad построение поверхности amrule

VBA AutoCad построение поверхности amrule

Ответ
Поиск в этой теме
Непрочитано 18.10.2006, 19:23 #1
VBA AutoCad построение поверхности amrule
Alexi
 
СПб
Регистрация: 18.10.2006
Сообщений: 15

Нужно програмно построить поверхность по сечениям. Сечения строятся в программе, имена есть.
пыталась сделать

Код:
[Выделить все]
Dim sttt As String
sttt = "amrule " & "(handent " & Chr(34) & CStr(polin(1).Handle) & Chr(34) & ")" & vbCr
sttt = sttt & "(handent " & Chr(34) & CStr(polin(2).Handle) & Chr(34) & ")" & vbCr
ThisDrawing.SendCommand (sttt)
но так не срабатывает.
Помогите пожалуйста. Спасибо.
Просмотров: 4811
 
Непрочитано 18.10.2006, 20:33
#2
C1


 
Регистрация: 13.06.2005
Сообщений: 314


"(handent " & Chr(34) & CStr(polin(1).Handle) & Chr(34) & ")" можно заменить на
Hex(polin(1).ObjectID)
C1 вне форума  
 
Автор темы   Непрочитано 19.10.2006, 14:04
#3
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


Видимо у меня слишком мало опыта, не смогла разобраться. Может расскажите чуть подробнее? Спасибо.
Alexi вне форума  
 
Непрочитано 19.10.2006, 14:33
#4
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


У меня нет MDT, да и VBA я не очень, поэтому если работать не будет, прошу ногами не бить:
Код:
[Выделить все]
Sub Test()
Dim objSelSet As AcadSelectionSet
Dim sSelSetName As String, lCounter As Long
Dim arPLine() As AcadObject, objCounter As AcadObject
  sSelSetName = "tempselset"
  On Error Resume Next
  ThisDrawing.SelectionSets.Item(sSelSetName).Clear
  ThisDrawing.SelectionSets.Item(sSelSetName).Delete
  Set objSelSet = ThisDrawing.SelectionSets.Add(sSelSetName)
  objSelSet.SelectOnScreen
  ReDim arPLine(objSelSet.Count)
  For Each objCounter In objSelSet
    arPLine(lCounter) = objCounter
    lCounter = lCounter + 1
  Next objCounter
  ThisDrawing.SendCommand "_armule" & vbCr & _
    "(handent " & Chr(34) & arPLine(0).Handle & Chr(34) & ")" & vbCr & _
    "(handent " & Chr(34) & arPLine(1).Handle & Chr(34) & ")" & vbCr
End Sub
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.10.2006, 14:56
#5
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


Нет к сожалению это тоже не работает.
Alexi вне форума  
 
Автор темы   Непрочитано 19.10.2006, 15:03
#6
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


Там как я подозреваю ошибка в том что команду amrule любой объет не устраивает, ей нужен определенный, а находится Entity.
А вот как запустить с Hex(polin(1).ObjectID) я так и не разобралась.
Alexi вне форума  
 
Автор темы   Непрочитано 19.10.2006, 15:27
#7
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


запустила все таки с Hex(polin(1).ObjectID), но опять ничего не вышло. Пишет Nothing selected.
Может способ все же есть?
Alexi вне форума  
 
Непрочитано 19.10.2006, 15:30
#8
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Так а если выбрать-таки тот устраивающий объект и первым, и вторым? Потом выяснить, что ж это за объекты и попробовать сделать фильтр на SelectionSet.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.10.2006, 15:39
#9
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


Функция handent возвращает Entity, причем как я поняла всегда.
Alexi вне форума  
 
Непрочитано 19.10.2006, 15:52
#10
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Собственно команда как работает? Что возвращает handent сейчас вряд ли имеет критическое значение...
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 19.10.2006, 15:57
#11
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


команда работает очень просто
amrule
запрашивает Select first wire:
выбираешь мышкой нужный объект
запрашивает Select second wire:
выбираешь
строит поверхность. все.
вот только нужно без мышки. И видимо вся проблема в этом wire.
Потому что для select objects все написанное работает.
Alexi вне форума  
 
Непрочитано 19.10.2006, 19:25
#12
C1


 
Регистрация: 13.06.2005
Сообщений: 314


Попробуйте сдедать так, что бы у получалось из командной строки. А потом перенесите в SendCommand эти команды.
Можно предварительно выбирать объекты через группы (командой group) или в VBA:

Dim groupColl As AcadGroups
Set groupColl = ThisDrawing.Groups
Dim Group1 As AcadGroup
Dim Group2 As AcadGroup
Set Group1 = groupColl.Add("gr1")
Set Group2 = groupColl.Add("gr2")
Dim Objs1(0) As AcadEntity
Dim Objs2(0) As AcadEntity
Set Objs1(0) = polin(1)
Set Objs2(0) = polin(2)
Group1.AppendItems Objs1
Group2.AppendItems Objs2

При выборе объектов из командной строки писать букву g и имя группы:

ThisDrawing.SendCommand "_amrule g gr1 g gr2 "
C1 вне форума  
 
Автор темы   Непрочитано 20.10.2006, 11:06
#13
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


Нет, это не помогает. Этот способ работает если предлагается Select objects, тогда после g спрашивается имя группы, а при запрашивании Select first wire: g не воспринимается.
Alexi вне форума  
 
Непрочитано 20.10.2006, 11:32
#14
C1


 
Регистрация: 13.06.2005
Сообщений: 314


А как вообще из командной строки тогда удастся выбрать? У меня нет этой команды. Попробуйте вводом координат точек, которые пренадлежат polin(1) и polin(2). Например:
ThisDrawing.SendCommand "_amrule 0,0,0 0,0,10 ".
Так не получится? Возмите две конкретные точки.
Если сработает, то в программе:
Код:
[Выделить все]
    Dim p(1 to 2, 2) As Double
    Dim s(1 to 2) As String
    Dim i As Long
    Dim j As Long
    For i = 1 To 2
        For j = 0 To 2
            p(i, j) = polin(i).Coordinates(j)
            s(i) = s(i) & p(i, j)
            If j < 2 Then s(i) = s(i) & ","
        Next
    Next
    Dim sttt As String
    sttt = "_amrule " & s(1) & " " & s(2) & " "
    ThisDrawing.SendCommand sttt
C1 вне форума  
 
Автор темы   Непрочитано 20.10.2006, 13:33
#15
Alexi


 
Регистрация: 18.10.2006
СПб
Сообщений: 15


Спасибо большое, это работает. Даже не верится.
Но у меня теперь другая проблема, моя polin это полилиния. И с определением координаты Z явные проблемы.
Alexi вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > VBA AutoCad построение поверхности amrule

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск