[plugin]

С помощью ssget можно получить набор примитивов внутри выпуклой полилинии. А как получить набор примитивов находящихся снаружи полилинии, или хотя бы прямоугольника?

[Griin]

Сообщение от sime А можно сделать так что бы выбрать несколько контуров и удалить все что снаружи?

Вот тот-же вопрос. Можно ли этот lisp доработать таким образом?

[Олег (jr.)]

Смотри здесь:
http://forums.autodesk.com/t5/Visual...883703#M232901

[Griin]

Сообщение от Олег (jr.) Смотри здесь: http://forums.autodesk.com/t5/Visual...883703#M232901

Что-то не работает: скопировал, установил, прописываю в командной строке (SelByObj)- а он выдает мне "; ошибка: слишком мало аргументов"

----- добавлено через 27 сек. -----
В чем проблема?

[VVA]

Не то взываешь. Там есть команды SSOW и SSOC. Подробнее читай в моей подписи

[Griin]

Сообщение от VVA Там есть команды SSOW и SSOC

Выдает другую ошибку: ; ошибка: неверная строка режима ssget
Вот код, который я скопировал:

Код:

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

 ;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Creates a selection set from an object (circle ellipse or closed
;;; lwpolyline) by Window Polygon or Crossing Polygon.
;;;
;;; Arguments :
;;; - ename
;;; - selection mode (Cp or Wp)
;;; - selection filter or nil

(defun SelByObj (ent opt fltr / obj dist n lst prec dist p_lst)
(vl-load-com)
(if (= (type ent) 'ENAME)
(setq obj (vlax-ename->vla-object ent))
)
(cond
((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
(setq dist (/ (vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
50
)
n 0
)
(repeat 50
(setq
lst
(cons
(trans
(vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
0
1
)
lst
)
)
)
)
(T
(setq p_lst (vl-remove-if-not
'(lambda (x)
(or (= (car x) 10)
(= (car x) 42)
)
)
(entget ent)
)
)
(while p_lst
(setq
lst
(append
lst
(list (trans (append (cdr (assoc 10 p_lst))
(list (cdr (assoc 38 (entget ent))))
)
ent
1
)
)
)
)
(if (/= 0 (cdadr p_lst))
(progn
(setq prec (1+ (fix (* 50 (abs (cdadr p_lst)))))
dist (/ (- (if (cdaddr p_lst)
(vlax-curve-getDistAtPoint
obj
(trans (cdaddr p_lst) ent 0)
)
(vlax-curve-getDistAtParam
obj
(vlax-curve-getEndParam obj)
)
)
(vlax-curve-getDistAtPoint
obj
(trans (cdar p_lst) ent 0)
)
)
prec
)
n 0
)
(repeat (1- prec)
(setq
lst (append
lst
(list
(trans
(vlax-curve-getPointAtDist
obj
(+ (vlax-curve-getDistAtPoint
obj
(trans (cdar p_lst) ent 0)
)
(* dist (setq n (1+ n)))
)
)
0
1
)
)
)
)
)
)
)
(setq p_lst (cddr p_lst))
)
)
)
(ssget (strcat "_" opt) lst fltr)
)

;;; Examples (remove space between < and OR or AND):

;;; SSOC Selection by Crossig

(defun c:ssoc (/ ss opt)
(sssetfirst nil nil)
(if (setq ss (ssget "_:smileyfrustrated::E"
(list
'(-4 . "< OR")
'(0 . "CIRCLE")
'(-4 . "< AND")
'(0 . "ELLIPSE")
'(41 . 0.0)
(cons 42 (* 2 pi))
'(-4 . "AND>")
'(-4 . "< AND")
'(0 . "LWPOLYLINE")
'(-4 . "&")
'(70 . 1)
'(-4 . "AND>")
'(-4 . "OR>")
)
)
)
(sssetfirst
nil
(ssdel (ssname ss 0) (SelByObj (ssname ss 0) "Cp" nil))
)
)
(princ)
)

;;; SSOW Selection by Window

(defun c:ssow (/ ss opt)
(sssetfirst nil nil)
(if (setq ss (ssget "_:smileyfrustrated::E"
(list
'(-4 . "< OR")
'(0 . "CIRCLE")
'(-4 . "< AND")
'(0 . "ELLIPSE")
'(41 . 0.0)
(cons 42 (* 2 pi))
'(-4 . "AND>")
'(-4 . "< AND")
'(0 . "LWPOLYLINE")
'(-4 . "&")
'(70 . 1)
'(-4 . "AND>")
'(-4 . "OR>")
)
)
)
(sssetfirst nil (SelByObj (ssname ss 0) "Wp" nil))
)
(princ)
)

;;; Inv_Sel Inverse a selection set

(defun c:inv_sel (/ ssa ssf n e)
(setq ssa (ssget "_A" '((0 . "~VIEWPORT"))))
(if (setq ssf (cadr (ssgetfirst)))
(repeat (setq n (sslength ssa))
(if (ssmemb (setq e (ssname ssa (setq n (1- n)))) ssf)
(ssdel e ssa)
)
)
)
(sssetfirst)
(sssetfirst nil ssa)
(princ)
)

[gomer]

Вместо нужно написать :S

[VVA]

Сообщение от gomer Вместо нужно написать :S

В коде поста #25 вместо "_:smileyfrustrated::E" должно быть "_:S:E"

[skkkk]

ObjectARX для Autocad 2010-2014. Выделение элементов по существующим контурам

[Griin]

Сообщение от gomer Вместо нужно написать :S

Сообщение от VVA В коде поста #25 вместо "_:smileyfrustrated::E" должно быть "_:S:E"

Сообщение об ошибке исчезло но выделения не происходит.

Сообщение от skkkk ObjectARX для Autocad 2010-2014. Выделение элементов по существующим контурам

У меня 2008 Autocad

[Serhio163]

Сообщение от VVA Выше быстро переделанный код удаления снаружи полилинии с обрезкой.

Здравствуйте, помогите пожалуйста дописать код
В модели есть блок "Страница", процедура "Обрезка" находит блок, взрывает его, выбирает из обломков замкнутую полилинию (контур) и устанавливает подрезку растра по этому контуру
За этим мне нужно осуществить обрезку чертежа снаружи по этому же контуру... на VBA ничего не удалось найти, Ваш лисп OCD работает как надо, но с выбором руками контура...
Как можно передать в лисп этот контур?

Код:

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

Sub Обрезка()
Dim ss As AcadSelectionSet
Dim объект As AcadObject
    Dim intType(0) As Integer
    Dim varData(0) As Variant
    
    intType(0) = 410
    varData(0) = "Model"


    Dim AE As AcadEntity

Set ss = SelectAll(intType, varData)
        For Each объект In ss
            On Error Resume Next
            If TypeOf объект Is AcadRasterImage And объект.Name = "растр" Then
                объект.ClippingEnabled = True
                Set AE = КонтурСтраницы("Страница")
                объект.ClipBoundary AE.Coordinates
                
                comStr = "(if (null OCD) (load " & Chr(34) & папка_лисп & "OCD.LSP" & Chr(34) & "))"
                ThisDrawing.SendCommand comStr & vbCr
                ThisDrawing.SendCommand "OCD" & vbCr
                
                'AE.Delete
            End If
        Next объект

End Sub

Код:

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

Public Function КонтурСтраницы(Optional имя_блока As String) As AcadObject
    Dim ss As AcadSelectionSet
    Dim объект As AcadBlockReference 'AcadObject
    Dim dynProps1() As AcadDynamicBlockReferenceProperty
    Dim dynProps2() As AcadDynamicBlockReferenceProperty

    
    Dim страница$
    
    'Создаем набор выбора
    Set ss = CreateSelect(ss, "objects")
    
    Dim intType(3) As Integer
    Dim varData(3) As Variant
    
    'Настраиваем фильтр выбора только блоков в пространстве модели
    intType(0) = -4
    varData(0) = "<AND"
    intType(1) = 410
    varData(1) = "Model"
    intType(2) = 0
    varData(2) = "INSERT"
    intType(3) = -4
    varData(3) = "AND>"
    
    'Создаем набор объектов
    ss.Select acSelectionSetAll, , , intType, varData
    
    'Бежим по набору объектов модели
    If ss.Count > 0 Then
        
        For Each объект In ss
            
            'Если имя блока рамка и штамп, то
            If объект.EffectiveName = имя_блока Then
                ' Взорвем блочную ссылку
                Dim explodedObjects As Variant
                explodedObjects = объект.explode
            ' Перечислим полученные обломки
                Dim Iex As Integer
                For Iex = 0 To UBound(explodedObjects)
                    If Not explodedObjects(Iex).ObjectName = "AcDbPolyline" Then
                        explodedObjects(Iex).Delete
                    Else
                        explodedObjects(Iex).color = acGreen
                        Set КонтурСтраницы = explodedObjects(Iex)

                    End If
                Next
            End If
        Next объект

    Else
        
        ThisDrawing.Utility.Prompt "В модели нет ни такого блока!"

        Exit Function
        
    End If

End Function