[macros55]

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

[Солидворкер]

Поскольку речь о Lisp, перемещено в раздел Программирование.

Автору советую попробовать расписать чуть более понятно свой вопрос.

It may be better to write in English?

[skkkk]

Может, Выделение объектов в области контура, AutoCAD или LISP.Выделение объектов в области контура поможет?

[macros55]

очень спасибо skkkk

[macros55]

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

[Кулик Алексей aka kpblc]

Что, простите?

[Сергей812]

Offtop: Человек с говорящим ником macros третий год просит написать ему лисп

[Admin]

Offtop: Он просто через переводчик пишет, как может.

[macros55]

Naprimer commanda FS(fastsell) mojno sellect tolko odin obyekt...a mne nujno sellect neskolko obyet

[Сергей812]

FS:Будет несколько взаимопересекающихся объектов - выделит несколько. Чего вообще нужно то?

[macros55]

Все, что касается много выборного него, чтобы выбрать БЛОК,

[Сергей812]

выборного него? Пока не сформулируете вопрос полностью и вразумительно, в развернутом виде - никто не даст ответа.

[VVA]

Сообщение от macros55 Naprimer commanda FS(fastsell) mojno sellect tolko odin obyekt...a mne nujno sellect neskolko obyet

Может быть SelSIM Александра Ривилиса?
Попробуй сформулировать вопрос на родном для себя языке.

[Profan]

Выборного ЕГО.

[macros55]

Код:

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

 (defun c:ns (/ ss xs ls i ob n so) (vl-load-com)
  (if (setq ss (ssget))
    (progn
      (setq xs (ssget "x") ls (ssadd) i (sslength ss))
      (repeat i
        (setq ls (ssadd (setq ob (ssname ss (setq i (1- i)))) ls))
        (repeat (setq n (sslength xs))
          (if (not (minusp (vlax-safearray-get-u-bound (vlax-variant-value
                (vla-Intersectwith (vlax-ename->vla-object ob)
                (vlax-ename->vla-object (setq so (ssname xs
                (setq n (1- n))))) 0)) 1)))
            (setq ls (ssadd so ls)))
        )
      ) (sssetfirst nil ls)
    )
  ) (princ)
)

проблем это Выберите несколько объектов и запуске SELECTSIMILAR все объект выбранный и запуске Lisp(NS)не работает.

ещё проблем (NS) запуске выбирать несколько объект и запуске ENTER все объект выбранный на этот раз blok Не выбрано

[VVA]

Пробуй

Код:

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

 (defun c:ns (/ ss xs ls i ob n so) (vl-load-com)
  (if (setq ss (ssget "_I"))
    (progn
      (setq xs (ssget "_x" (list(cons 410 (getvar 'CTAB)))) ls (ssadd) i (sslength ss))
      (repeat i
        (setq ls (ssadd (setq ob (ssname ss (setq i (1- i)))) ls))
        (repeat (setq n (sslength xs))
          (if
            (VxGetInters
            (vlax-ename->vla-object ob)
            (vlax-ename->vla-object (setq so (ssname xs (setq n (1- n)))))
            acExtendNone
            )
            (setq ls (ssadd so ls))
            )
        )
      ) (sssetfirst nil ls)
    )
  ) (princ)
)

;
; -- Function VxGetInters
; Returns all intersection points between two objects.
; Copyright:
;   ©2000 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   Fst = First object [VLA-OBJECT]
;   Nxt = Second object [VLA-OBJECT]
;   Mde = Intersection mode [INT]
;         Constants:
;         - acExtendNone           Does not extend either object.
;         - acExtendThisEntity     Extends the Fst object.
;         - acExtendOtherEntity    Extends the Nxt object.
;         - acExtendBoth           Extends both objects.
; Return [Type]:
;   > List of points '((1.0 1.0 0.0)...[list]
;   > Nil if no intersection found
; Notes:
;   - None
; 
(defun VxGetInters (Fst Nxt Mde / IntLst PntLst)
 (setq IntLst (vlax-invoke Fst 'IntersectWith Nxt Mde))
 (cond
  (IntLst
   (repeat (/ (length IntLst) 3)
    (setq PntLst (cons
                  (list
                   (car IntLst)
                   (cadr IntLst)
                   (caddr IntLst)
                  )
                  PntLst
                 )
          IntLst (cdddr IntLst)
    )
   )
   (reverse PntLst)
  )
  (T nil)
 )
)

[macros55]

VVA очень спасибо

----- добавлено через ~36 мин. -----
VVA ещё проблем отметки нас есть разные и потом что разные отметки он не работает..только же работу в отметки..

[VVA]

Сообщение от macros55 отметки нас есть разные и потом что разные отметки он не работает

Предварительно Z или уровень всех объектов нужно привести к одному числу (Z=0). Смотри Z0
Другие варианты можно посмотреть здесь LISP. Обнуление координаты Z (аналог FLATTEN )

[macros55]

Я должен разных проектов отметки, а это невозможно там все отметки 0

[VVA]

Код:

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

(defun c:ns (/ ss xs ls i ob n so)
  (vl-load-com)
  (if (setq ss (ssget "_I"))
    (progn
      (setq xs (ssget "_x" (list (cons 410 (getvar 'CTAB))))
	    ls (ssadd)
	    i  (sslength ss)
      )
      (repeat i
	(setq ls (ssadd (setq ob (ssname ss (setq i (1- i)))) ls))
	(repeat	(setq n (sslength xs))
	  (if
	    (and
	      (vlax-write-enabled-p
		(vlax-ename->vla-object
		  (setq so (ssname xs (setq n (1- n))))
		)
	      )
	      (not
		(minusp
		  (cdr
		    (assoc
		      62
		      (entget
			(tblobjname "Layer" (cdr (assoc 8 (entget so))))
		      )
		    )
		  )
		)
	      )
	      (vlax-write-enabled-p (vlax-ename->vla-object ob))
	      (VxGetIntersZ0
		(vlax-ename->vla-object ob)
		(vlax-ename->vla-object so)
		acExtendNone
	      )
	    )
	     (setq ls (ssadd so ls))
	  )
	)
      )
      (sssetfirst nil ls)
      (princ "\nSelect ")
      (princ (sslength ls))
      (princ " primitives")
    )
    (alert "Please, select primives first")
  )
  (princ)
)

;;;;
;;;; -- Function VxGetInters
;;;; Returns all intersection points between two objects.
;;;; Copyright:
;;;;   ©2000 MENZI ENGINEERING GmbH, Switzerland
;;;; Arguments [Type]:
;;;;   Fst = First object [VLA-OBJECT]
;;;;   Nxt = Second object [VLA-OBJECT]
;;;;   Mde = Intersection mode [INT]
;;;;         Constants:
;;;;         - acExtendNone           Does not extend either object.
;;;;         - acExtendThisEntity     Extends the Fst object.
;;;;         - acExtendOtherEntity    Extends the Nxt object.
;;;;         - acExtendBoth           Extends both objects.
;;;; Return [Type]:
;;;;   > List of points '((1.0 1.0 0.0)...[list]
;;;;   > Nil if no intersection found
;;;; Notes:
;;;;   - None
;;;; 
(defun VxGetIntersZ0 (Fst Nxt Mde / IntLst PntLst Fst1 Nxt1)
  (setq	Fst1 (vla-copy Fst)
	Nxt1 (vla-copy Nxt)
  )
  (foreach n '(1e99 -1e99)
    (vla-move Fst1
	      (vlax-3d-point (list 0 0 0))
	      (vlax-3d-point (list 0 0 n))
    )
    (vla-move Nxt1
	      (vlax-3d-point (list 0 0 0))
	      (vlax-3d-point (list 0 0 n))
    )
  )
  (vl-catch-all-apply
    '(lambda ()
       (setq IntLst (vlax-invoke Fst1 'IntersectWith Nxt1 Mde))
     )
  )
  (vla-delete Fst1)
  (vla-delete Nxt1)
  (cond
    (IntLst
     (repeat (/ (length IntLst) 3)
       (setq PntLst (cons
		      (list
			(car IntLst)
			(cadr IntLst)
			(caddr IntLst)
		      )
		      PntLst
		    )
	     IntLst (cdddr IntLst)
       )
     )
    )
    (T nil)
  )
  (reverse PntLst)
)

[macros55]

письма ошибки ; error: AutoCAD.Application: Not applicable

[VVA]

macros55, Выложи файл с примером

[macros55]

Никаких проблем по установке, но LISP принадлежит ей ошибка

Command: NS
; error: AutoCAD.Application: Not applicable
Command:

[VVA]

macros55, Мне нужен dwg файл, в котором возникает данная ошибка. У меня все работает. Сообщи так же версию и разрядность Автокада
I need a dwg file in which the error occurs. Please attach it.

[macros55]

Это мой проект http://forum.dwg.ru/attachment.php?a...1&d=1452493226

[VVA]

Update #20 Try again

[macros55]

VVA большой спасибо lisp super...ещё маленький проблем

Что происходит?

VVA ещё второй маленький проблем

[VVA]

macros55, Потому что метод IntersectWith для блока ищет пересечение не с примитивами, входящими в блок, а с его ограничивающим прямоугольником (bounding box)

Код:

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

(defun C:TEST ()
  ;;;Command Test draw block's bounding box
  (vl-load-com)
(and
  (setq tmp_blk (car(entsel "\nselect Block : ")))
  (or (vla-GetBoundingBox (vlax-ename->vla-object tmp_blk) 'MinPt 'MaxPt) t) ;_Границы блока
  (setq	MinPt (vlax-safearray->list MinPt)
       MaxPt (vlax-safearray->list MaxPt)
	)
  (vl-cmdf "_Rectang" "_none" (list(car MinPt)(cadr MinPt)) "_none" (list(car MaxPt)(cadr MaxPt)))
  )
  )

[macros55]

VVA (bounding box) ладно большой спасибо..но почему выбрали OFF LAYER (второй картинке)

[VVA]

Сообщение от macros55 но почему выбрали OFF LAYER (второй картинке)

Потому что не было сказано, что этого делать не следует
Завтра посмотрю, что можно сделать

----- добавлено через ~13 ч. -----
Обновил #20
Update #20 Try again

[macros55]

VVA большой спасибо..lisp

----- добавлено через ~1 ч. -----
VVA можно следующий вопрос?

[macros55]

new lisp

[macros55]

извини первая картинке (0.50) это неправильно как, удалить ее ...правильно второй картинке (0.05)

[macros55]

VVA ?