[gizmo_zx]

Добрый день.
Кто поможет с програмкой, которая выделяла (аналог qselect) только подсвеченные объекты (Highlight) в модели.
Есть программа на VBA, после ее нароботы остаются подсвеченные объекты, но сделать сними ничего нельзя (копировать, открыть общие свойства). Возможно ли на lisp их выделить?

[Олег (jr.)]

Просто

Код:

[Выделить все]

(defun C:CHLIGHT(/ acdoc pf)
  (vl-load-com)
  (setq pf (vla-get-pickfirstselectionset
	     (setq adoc
		    (vla-get-activedocument
	       (vlax-get-acad-object))))
	)
  (vlax-for obj pf
    (vla-put-color obj acblue)
    (vla-highlight obj :vlax-false)
    )
  (sssetfirst nil nil)
 
  (princ))

[gizmo_zx]

Сообщение от Олег (jr.) Просто

Чегото не работает.
А очень нужно

Подозреваю нужны дополнительные функции?
Я вобще далек от lisp.

[Олег (jr.)]

Сообщение от gizmo_zx Чегото не работает. А очень нужно Подозреваю нужны дополнительные функции? Я вобще далек от lisp.

Сначала надо выбрать объекты-чтобы были видны ручки
Потом запустить программу

[gizmo_zx]

Сообщение от Олег (jr.) Сначала надо выбрать объекты-чтобы были видны ручки Потом запустить программу

Есть программа на VBA поиск блоков по имени, атрибуту, значению атрибута.

Программа ставит найденному блоку флаг хайлайт.
Но мне их надо выбрать.

чегото все равно не выходит (возможно при выборе (когда появляются ручки (флаг хайлата сьрасывается)
или другой путь как на VBA добавить объекты в новый набор и оставить выделинными на экране после завершения

[Nike]

Сообщение от gizmo_zx Есть программа на VBA поиск блоков по имени, атрибуту, значению атрибута.

Есть аналогичная программулина на LISP, в том числе с возможностью выбор по текстовой маске и выделением блоков. Надо?

[Олег (jr.)]

Сообщение от gizmo_zx Есть программа на VBA поиск блоков по имени, атрибуту, значению атрибута. Программа ставит найденному блоку флаг хайлайт. Но мне их надо выбрать. чегото все равно не выходит (возможно при выборе (когда появляются ручки (флаг хайлата сьрасывается) или другой путь как на VBA добавить объекты в новый набор и оставить выделинными на экране после завершения

Пробуй свой проект

[gizmo_zx]

Сообщение от Олег (jr.) Пробуй свой проект

А как мне удалить из начального выбора "oSset.SelectOnScreen dxftype, dxfdata" неподходящие элементы, чтобы остались только нужные?

[Олег (jr.)]

Сообщение от gizmo_zx А как мне удалить из начального выбора "oSset.SelectOnScreen dxftype, dxfdata" неподходящие элементы, чтобы остались только нужные?

Посмотри пример
Сначала выбираются все объекты, потом выбираешь
ненужные во второй набор и они удаляются из основного
набора
Изменяй под свои условия сам

Код:

[Выделить все]

Sub SubtractSSetExample()
    Dim oSset As AcadSelectionSet
    Dim oRset As AcadSelectionSet
    Dim oEnt As AcadEntity
    Dim rEnt As AcadEntity
    Dim i
    With ThisDrawing.SelectionSets
        While .Count > 0
            .Item(0).Delete
        Wend
        Set oSset = .Add("$SelectAllYouWant$")
        Set oRset = .Add("$SelectYouWantToSubstract$")
    End With

    MsgBox "Select all objects"
    oSset.SelectOnScreen
    MsgBox "Selected: " & oSset.Count & " objects"
    MsgBox "Select objects to be removed"
    oRset.SelectOnScreen
    MsgBox "Selected: " & oRset.Count & " objects"
    
    For i = oSset.Count - 1 To 0 Step -1
    Set oEnt = oSset.Item(i)
    For Each rEnt In oRset
    If oEnt.ObjectID = rEnt.ObjectID Then
    Dim remObj(0) As AcadEntity
    Set remObj(0) = oEnt
    oSset.RemoveItems remObj
    Exit For
    End If
    Next rEnt
    Next i
    MsgBox "Still in the parent selection set: " & oSset.Count & " objects"
    
End Sub

~'J'~

[gizmo_zx]

А как оставить выделенными объекты oSset.
т.е. остались выделенными после окончания макроса: "(все объекты)" минус "(которые удалить из набора)"

Код:

[Выделить все]

    Dim cmd As String
    cmd = "(sssetfirst (ssget " & Chr(34) & "_P" & Chr(34) & ")" & " " & "(ssget " & Chr(34) & "_P" & Chr(34) & "))" & vbCr    
    ThisDrawing.SendCommand cmd

не момогат все равно возращает полный набор, в том числе и исключенные объекты

[Олег (jr.)]

Сообщение от gizmo_zx А как оставить выделенными объекты oSset. т.е. остались выделенными после окончания макроса: "(все объекты)" минус "(которые удалить из набора)" Код: [Выделить все] Dim cmd As String cmd = "(sssetfirst (ssget " & Chr(34) & "_P" & Chr(34) & ")" & " " & "(ssget " & Chr(34) & "_P" & Chr(34) & "))" & vbCr ThisDrawing.SendCommand cmd не момогат все равно возращает полный набор, в том числе и исключенные объекты

Пробуй

[gizmo_zx]

СУПЕР!
Примного благодарен!
Просто мечта!

[Олег (jr.)]

Ну и ладушки...

[gizmo_zx]

Нашел баг, как поправить...?
проблемма возникает при большом колличестве блоков.

Предположительно слишком длинная строка cmd

Код:

[Выделить все]

ThisDrawing.SendCommand cmd

в комадной строке Acad:

(setq ss (ssadd))(ssadd (handent "130A1") ss)(ssadd (handent "1309D")
ss)(ssadd (handent "13099") ss)(ssadd (handent "13095") ss)(ssadd (handent
"1308D") ss)(ssadd (handent "13089") ss)(ssadd (handent "13085") ss)(ssadd
(handent "13081") ss)(ssadd (handent
((_>
'тут висит ожидая действия
*Прервано*
; ошибка: Функция отменена


нужные объекты остаются подсвечены, т.е. Highlight , но не выбраны

[Лиспер]

dvb не открывал, тем не менее: я бы "разделил" строку символами Enter'a (по-моему, chr(13))

[gizmo_zx]

Сообщение от Лиспер dvb не открывал, тем не менее: я бы "разделил" строку символами Enter'a (по-моему, chr(13))

не прокатило

фрагмент кода.

Код:

[Выделить все]

cmd = "(setq ss (ssadd))"
'создаем лисп выражение для посылки в командную строку
For Each oEnt In nSset

cmd = cmd & "(ssadd (handent " & Chr(34) & oEnt.Handle & Chr(34) & ") ss) " 

Next

cmd = cmd & "(princ)(sssetfirst ss ss)" & vbCr

ThisDrawing.SendCommand cmd

Прокатывает если найденых объектов мало и строка получается маленькой (предположительно <255)

[Лиспер]

А если так?

Код:

[Выделить все]

For Each oEnt In nSset

cmd = cmd & vbCr & "(ssadd (handent " & Chr(34) & oEnt.Handle & Chr(34) & ") ss) " 

Next

[gizmo_zx]

листинг командной строки

Код:

[Выделить все]

_find_block_by_ vbarun
Имя макроса: find_block_by_
Выберите объекты:
Выберите объекты: Противоположный угол: найдено: 6
Выберите объекты:
Команда:
Команда: (setq ss (ssadd))
<Selection set: 43>
Команда: (ssadd (handent "110E92") ss) <Selection set: 43>
Команда:
_FIND_BLOCK_BY_ vbarun
Имя макроса: find_block_by_ Ошибка при выполнении
Команда:
Команда: (ssadd (handent "110E80") ss) <Selection set: 43>
Команда:
_FIND_BLOCK_BY_ vbarun
Имя макроса: find_block_by_ Ошибка при выполнении
Команда:
Команда: (ssadd (handent "110E6E") ss) <Selection set: 43>
Команда:
_FIND_BLOCK_BY_ vbarun
Имя макроса: find_block_by_ Ошибка при выполнении
Команда:
Команда: (ssadd (handent "110E5C") ss) <Selection set: 43>
Команда:
_FIND_BLOCK_BY_ vbarun
Имя макроса: find_block_by_ Ошибка при выполнении
Команда:
Команда: (ssadd (handent "5D5DB") ss) <Selection set: 43>
Команда: (princ)(sssetfirst ss ss)
(<Selection set: 43> <Selection set: 43>)

т.е. ентер перезапускает весь макрос VBA...
тут наверно какаято хитрость нужна

[Лиспер]

Проще всего будет записать временный lsp-файл и его загрузить.

[ShaggyDoc]

Сообщение от Лиспер Проще всего будет записать временный lsp-файл и его загрузить.

Правильно. И самое разумное через SendCommand послать только команду загрузки этого файла. Кроме совсем элементарных случаев.