Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Здравствуйте!
Нужно отфильтровать выбор примитивов в SelectionSet удовлетворяющим только двум условиям:
- блок с именем "XXX"
- полилиния в слое "YYY"
Как сформировать команду на выбор с подобными условиями не могу разобраться. Помогите.
Заранее спасибо.
Попробуй так:
Public Sub SelectTest()
Dim sset As AcadSelectionSet
Dim existSset As Boolean
For Each sset In ThisDrawing.SelectionSets
If sset.Name = "SelectTest" Then
sset.Clear
existSset = True
Exit For
End If
Next
If existSset = False Then
Set sset = ThisDrawing.SelectionSets.Add("SelectTest")
End If
Dim myBlName As String
myBlName = "123"
Dim myPlLayer As String
myPlLayer = "0"
Dim code(0 To 13) As Integer
Dim data(0 To 13) As Variant
code(0) = -4: data(0) = "<OR"
code(1) = -4: data(1) = "<AND"
code(2) = 0: data(2) = "INSERT"
code(3) = 2: data(3) = myBlName
code(4) = -4: data(4) = "AND>"
code(5) = -4: data(5) = "<AND"
code(6) = 0: data(6) = "POLYLINE"
code(7) = 8: data(7) = myPlLayer
code(8) = -4: data(8) = "AND>"
code(9) = -4: data(9) = "<AND"
code(10) = 0: data(10) = "LWPOLYLINE"
code(11) = 8: data(11) = myPlLayer
code(12) = -4: data(12) = "AND>"
code(13) = -4: data(13) = "OR>"
sset.SelectOnScreen code, data
MsgBox sset.Count & " объектов найдено, удовлетворяющих фильтру."
sset.Delete
End SubУправление наборами тупо сделано, но для работы примера достаточно.
Мда. Можно мозг сломать(
Большое спасибо.
А если мне нужны только LWPolyline и BlockReference, значит нужно написать так:
code(0) = -4: data(0) = "<OR" code(1) = -4: data(1) = "<AND" code(2) = 0: data(2) = "INSERT" code(3) = 2: data(3) = myBlName code(4) = -4: data(4) = "AND>" code(5) = -4: data(5) = "<AND" code(6) = 0: data(6) = "LWPOLYLINE" code(7) = 8: data(7) = myPlLayer code(8) = -4: data(8) = "AND>" code(9) = -4: data(9) = "OR>"
Правильно?
Правильно?
Что правильно? Оставить только LwPolyline? Честно, я без понятие чем отличается Polyline от LwPolyline. Polyline видимо, старая версия полилинии, сохраняющаяся в новых версиях автокада для поддержки старых версий. По мне, так лучше бы преобразовывали налету старые полилинии в новые. И был бы один тип полилинии Polyline. А может быть я и не прав, и разные типы полилиний имеют разные практические применения.
Можно мозг сломать(
Возможно, если вот так структурировать, то станет нагляднее:
code(0) = -4: data(0) = "<OR"
code(1) = -4: data(1) = "<AND"
code(2) = 0: data(2) = "INSERT"
code(3) = 2: data(3) = myBlName
code(4) = -4: data(4) = "AND>"
code(5) = -4: data(5) = "<AND"
code(6) = 0: data(6) = "POLYLINE"
code(7) = 8: data(7) = myPlLayer
code(8) = -4: data(8) = "AND>"
code(9) = -4: data(9) = "<AND"
code(10) = 0: data(10) = "LWPOLYLINE"
code(11) = 8: data(11) = myPlLayer
code(12) = -4: data(12) = "AND>"
code(13) = -4: data(13) = "OR>" Принцип то простой.
...наверное, я понял
Большое спасибо! :{}
Честно, я без понятие чем отличается Polyline от LwPolyline. Polyline видимо, старая версия полилинии, сохраняющаяся в новых версиях автокада для поддержки старых версий. По мне, так лучше бы преобразовывали налету старые полилинии в новые. И был бы один тип полилинии Polyline. А может быть я и не прав, и разные типы полилиний имеют разные практические применения.
Всё несколько сложнее. LWPOLYLINE не может быть 3D (т.е. она всегда плоская), не может быть сглаженная и т.д.
Вместо
code(5) = -4: data(5) = "<AND"
code(6) = 0: data(6) = "POLYLINE"
code(7) = 8: data(7) = myPlLayer
code(8) = -4: data(8) = "AND>"
code(9) = -4: data(9) = "<AND"
code(10) = 0: data(10) = "LWPOLYLINE"
code(11) = 8: data(11) = myPlLayer
code(12) = -4: data(12) = "AND>" Можно написать:
code(5) = -4: data(5) = "<AND"
code(6) = 0: data(6) = "POLYLINE,LWPOLYLINE"
code(7) = 8: data(7) = myPlLayer
code(8) = -4: data(8) = "AND>"Большое спасибо! :{}
Смайликом не ошибся? :D
;)
До кучи
Самый простой и надежный способ из тех, что встречались
Sub SelectionDemo()
Dim msg As String
Dim oEnt As AcadEntity
Dim ftype(0) As Integer
Dim fdata(0) As Variant
Dim dxfCode, dxfValue
Dim oLine As AcadLine
Dim oSpline As AcadSpline
Dim oPoly As AcadLWPolyline
Dim oPline As AcadPolyline
Dim oPoly3d As Acad3DPolyline
Dim oSset As AcadSelectionSet
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Curves$") '<-- use any name here
End With
ftype(0) = 0: fdata(0) = "*line" '<-- same as fdata(0) = "LWPOLYLINE,POLYLINE,SPLINE,LINE"
dxfCode = ftype: dxfValue = fdata
oSset.SelectOnScreen dxfCode, dxfValue
MsgBox "Selected: " & oSset.Count & " objects"
For Each oEnt In oSset
'cast even entity as exact object type:
If TypeOf oEnt Is AcadLine Then
Set oLine = oEnt
msg = msg & "Selected Line: " & oLine.Handle & vbCr
'do something with Line here
ElseIf TypeOf oEnt Is AcadSpline Then
Set oSpline = oEnt
msg = msg & "Selected Spline: " & oSpline.Handle & vbCr
'do something with Spline here
ElseIf TypeOf oEnt Is AcadLWPolyline Then
Set oPoly = oEnt
msg = msg & "Selected light polyline: " & oPoly.Handle & vbCr
'do something with light polyline here
ElseIf TypeOf oEnt Is AcadPolyline Then
Set oPline = oEnt
msg = msg & "Selected 2d polyline: " & oPline.Handle & vbCr
'do something with heavy 2d polyline here
ElseIf TypeOf oEnt Is Acad3DPolyline Then
Set oPoly3d = oEnt
msg = msg & "Selected 3d polyline: " & oPoly3d.Handle & vbCr
'do something with 3d polyline here
End If
Next oEnt
MsgBox VbCr & msg
End SubСтраницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форум работает на PunBB, при поддержке Informer Technologies, Inc
