Выбор примитивов или блоков из общей кучи выбранных элементов чертжа.

Mozgolom · 12.12.2019, 18:53

Подскажите, как можно реализовать следующее. Выбираю мышкой некую область на чертеже. Соответственно, выбираются все примитивы и блоки, которые попали в данную область. А теперь нужно отфильтровать их, то есть из общей кучи выбрать только определенные блоки, или определенные примитивы. Необходимо быстро массово выбрать определенные объекты из оющей кучи и удалить их.

Кулик Алексей aka kpblc · 12.12.2019, 18:56

Ну так смотри фильтры для ssget, в чем проблема?

Сергей812 · 12.12.2019, 19:35

т.е. хотите написать аналог быстрого выбора с предустановками?

Boxa · 13.12.2019, 06:49

раздел программирование, а какой язык не указано... Укажите яп.

Krieger · 13.12.2019, 11:01

Цитата:

Сообщение от Mozgolom

Подскажите, как можно реализовать следующее. Выбираю мышкой некую область на чертеже. Соответственно, выбираются все примитивы и блоки, которые попали в данную область. А теперь нужно отфильтровать их, то есть из общей кучи выбрать только определенные блоки, или определенные примитивы. Необходимо быстро массово выбрать определенные объекты из оющей кучи и удалить их.

Попробуй это. Писал для себя, поэтому местами сыровата, лень доделать. Не работает с динамическими блоками.
Вызывать командой ss. Потом указать по какому параметру сделать выбор и затем выбрать один из этих объектов.

Опция Similar выбирает примитивы по длине и площади.

Код:

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

 

(defun c:ss (/ ss ss1 ent keyword typeent entity attr tag value teg selset attrlist)
  (setq keyword t
	ss1 (ssadd))
  (if (setq ss (ssget))
  (while keyword
  (initget 128 "Layer Block Attribute Color Object coNtents Similar д и ф с щ т ы")
    
  (if (setq keyword (getkword "Что выбираем? [Layer (По слою), Block (По блоку), Attribute (Атрибут), Color (По цвету), Object (По объекту), coNtents (По содержанию текста), Similar (подобный)] <Выход> : "))

    (progn
    
  (cond
;=================

    
    ((or (eq keyword "Similar") (eq keyword "ы"))
    
(if
	  (setq ent (Kr_entsel "\nВыберите объект" nil nil))
		(cond
		  ((eq (cdr (assoc 0 (entget ent)))  "LINE")
		       (foreach entity (ssnamex ss) (if (eq (type (cadr entity)) 'ENAME)
						      (if (eq (cdr (assoc 0  (entget (cadr entity))))  "LINE")
							(if (eq (Kr_roundof (vla-get-Length (vlax-ename->vla-object (cadr entity))) 0.0001) (Kr_roundof (vla-get-Length (vlax-ename->vla-object ent)) 0.0001))
							 (ssadd (cadr entity) ss1)
							);if
						       );if
						      );if
			 );foreach
		   )

	;------------------------
		  ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ARC" "ELLIPSE" "SPLINE"))  
		       (foreach entity (ssnamex ss) (if (eq (type (cadr entity)) 'ENAME)
						      (if (member (cdr (assoc 0  (entget (cadr entity)))) '("CIRCLE" "ARC" "ELLIPSE" "SPLINE"))
							(if (eq (Kr_roundof (vla-get-Area (vlax-ename->vla-object (cadr entity))) 0.0001) (Kr_roundof (vla-get-Area (vlax-ename->vla-object ent)) 0.0001))
							 (ssadd (cadr entity) ss1)
							);if
						       );if
						      );if
			 );foreach
		   )
	;------------------------ 
		  		  ((member (cdr (assoc 0 (entget ent))) '("LWPOLYLINE"))
				   				     
		       (foreach entity (ssnamex ss) (if (eq (type (cadr entity)) 'ENAME)
						      (if (member (cdr (assoc 0  (entget (cadr entity)))) '("LWPOLYLINE"))
							(if (and (eq (Kr_roundof (vla-get-Area (vlax-ename->vla-object (cadr entity))) 0.0001) (Kr_roundof (vla-get-Area (vlax-ename->vla-object ent)) 0.0001))
								 (eq (Kr_roundof (vla-get-Length (vlax-ename->vla-object (cadr entity))) 0.0001) (Kr_roundof (vla-get-Length (vlax-ename->vla-object ent)) 0.0001)))
							 (ssadd (cadr entity) ss1)
							);if
						       );if
						      );if
			 );foreach
		   )
	;------------------------
		      
		 );cond

	  );if
     )
;=================

    ((or (eq keyword "Attribute") (eq keyword "ф"))
     
     (progn

       (if (setq attr (kr_nentsel "\nУкажи атрибут <выбрать атрибут в блоке>: " '("ATTRIB") nil))
	     	(setq	 attr (vlax-ename->vla-object attr)
			 tag   (vla-get-tagstring attr)
			 value (vla-get-textstring attr))
	 (if (setq blk (kr_entsel "\nУкажи блок с атрибутами: " '("INSERT") nil))
	   (if 	(setq 	teg (mydcldlg "Выбор атрибута" (foreach int (fun_get-attr (vlax-ename->vla-object blk)) (setq attrlist (append attrlist (list (strcat (vla-get-tagstring int) " - " (vla-get-textstring int))))))))
		(setq 	tag (car (dwgru-string-to-list teg " - "))
		 	value (cadr (dwgru-string-to-list teg " - "))
		 	attrlist nil);setq
	    );if
	 );if
	);if
       
       (if (and tag value)
	 (progn
	   ;сначала выберем все блоки имеющие атрибуты
	   (setq selset
	     (vl-remove-if-not
	     (function
	       (lambda (i)  (and
			     (eq (cdr (assoc 0 (entget i))) "INSERT")
			     (eq (cdr (assoc 66 (entget i))) 1))
		 )
	       )
	     (_kpblc-conv-selset-to-ename ss)
	     )
		 )

;теперь отсортируем блоки с нашим атрибутом
       (setq tag    (strcase tag)
             value  (strcase value)
             selset (vl-remove-if-not
                      (function
                        (lambda (x / lst)
                          (setq lst (mapcar
                                      (function
                                        (lambda (i)
                                          (cons (strcase (vla-get-tagstring i))
                                                (strcase (vla-get-textstring i))
                                                ) ;_ end of cons
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      (fun_get-attr (vlax-ename->vla-object x))
                                      ) ;_ end of mapcar
                                ) ;_ end of setq
                          (vl-remove-if-not
                            (function
                              (lambda (a)
                                (and (or (= (car a) tag) (wcmatch (car a) tag))
                                     (or (= (cdr a) value) (wcmatch (cdr a) value))
                                     ) ;_ end of and
                                ) ;_ end of lambda
                              ) ;_ end of function
                            lst
                            ) ;_ end of vl-remove-if-not
                          ) ;_ end of lambda
                        ) ;_ end of function
                      selset
                      ) ;_ end of vl-remove-if-not
             ;ss1    (ssadd)
             ) ;_ end of setq
       (foreach item selset
         (ssadd item ss1)
         ) ;_ end of foreach
	);progn
);if
	 






       );progn

     )

;=================
    ((or (eq keyword "Layer") (eq keyword "д")) (if (setq ent (Kr_entsel "\nВыберите объект" nil nil)) (setq typeent (assoc 8 (entget ent)))))
    ((or (eq keyword "Block") (eq keyword "и")) (if (setq ent (Kr_entsel "\nВыберите объект" '("INSERT") nil)) (setq typeent (assoc 2 (entget ent)))))
    ((or (eq keyword "Color") (eq keyword "с")) (if (setq ent (Kr_entsel "\nВыберите объект" nil nil)) (setq typeent (assoc 62 (entget ent)))))
    ((or (eq keyword "Object") (eq keyword "щ")) (if (setq ent (Kr_entsel "\nВыберите объект" nil nil)) (setq typeent (assoc 0 (entget ent)))))
    ((or (eq keyword "coNtents") (eq keyword "т")) (if (setq ent (Kr_entsel "\nВыберите содержание текста" '("TEXT" "MTEXT" "MULTILEADER") nil))
						     (setq
				   typeent (if
					     (or (eq (cdr (assoc 0 (entget ent)))  "TEXT")
						 (eq (cdr(assoc 0 (entget ent)))  "MTEXT"))
					     (assoc 1 (entget ent))
					     (assoc 304 (entget ent)));if
				   );setq
						     );if
     )
    );cond
  
(if typeent (foreach entity (ssnamex ss) (if (eq (type (cadr entity)) 'ENAME) (if (member typeent (entget (cadr entity))) (ssadd (cadr entity) ss1)))))
(setq typeent nil)
  
(if (> (sslength ss1) 0)
         (progn
           (command "_.Select" ss1 "")
           (command "_.PSelect" ss1 "")
	   ;(sssetfirst ss1 ss1)
	   ;(command "regen")
	   ;(setq fieldeval_var (getvar "fieldeval"))
	   ;(setvar "fieldeval" 0)
	   ;(vla-regen (vla-get-ActiveDocument (vlax-get-Acad-object)) acactiveviewport)
	   ;(setvar "fieldeval" fieldeval_var)
	   ;(princ)

	   
           )
         )
  
  );progn
   
    );if

    );while
    );if
  )



(defun mydcldlg (zagl info-list / fl ret dcl_id)
      ;;;Use
      ;;;(mydcldlg "Test" '("1" "2" "3" "4"))
      (vl-load-com)
      (if (null zagl)(setq zagl "Select")) ;_ end of if
      (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
      (setq ret (open fl "w"))
      (mapcar
        '(lambda (x) (write-line x ret))
        (list "mip_msg : dialog { "
              (strcat "label=\"" zagl "\";")
              " :list_box {"
              "alignment=top ;"
              "width=51 ;"
              "allow_accept = true;"
              "tabs = \"16 32\";"
              "tab_truncate = true;"
              (if (> (length info-list) 26)
                "height= 26 ;"
                (strcat "height= " (itoa (+ 3 (length info-list))) ";")
              ) ;_ end of if
              "is_tab_stop = false ;"
              "key = \"info\";}"
              "ok_cancel;}"
        ) ;_ end of list
      ) ;_ end of mapcar
      (setq ret (close ret))
      (if (and (not (minusp (setq dcl_id (load_dialog fl))))
               (new_dialog "mip_msg" dcl_id)
          ) ;_ end of and
        (progn
          (start_list "info")
          (mapcar 'add_list info-list)
          (end_list)
          (set_tile "info" "0")
          (setq ret (car info-list))
          (action_tile
            "info"
            "(setq ret (nth (atoi $value) info-list))"
          ) ;_ end of action_tile
          (action_tile
            "cancel"
            "(progn(setq ret nil)(done_dialog 0))"
          ) ;_ end of action_tile
          (action_tile "accept" "(done_dialog 1)")
          (start_dialog)
        ) ;_ end of progn
      ) ;_ end of if
      (unload_dialog dcl_id)
      (vl-file-delete fl)
      ret
    )




  (defun fun_get-attr (blk)
    (append (_kpblc-conv-vla-to-list (vla-getattributes blk))
            (_kpblc-conv-vla-to-list (vla-getconstantattributes blk))
            ) ;_ end of append
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((listp value)
       (mapcar '_kpblc-conv-vla-to-list value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (member (type value) (list 'ename 'str 'vla-object))
            (= (type (_kpblc-conv-ent-to-vla value)) 'vla-object)
            (vlax-property-available-p (_kpblc-conv-ent-to-vla value) 'count)
            ) ;_ end of and
       (vlax-for sub (_kpblc-conv-ent-to-vla value)
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun


  (defun _kpblc-conv-ent-to-vla (ent_value / res)
                                ;|
*    Функция преобразования полученного значения в vla-указатель.
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в указатель. Может
*			быть именем примитива, vla-указателем или просто
*			списком.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-vla (entlast))
(_kpblc-conv-ent-to-vla (vlax-ename->vla-object (entlast)))
|;
    (cond
      ((= (type ent_value) 'vla-object) ent_value)
      ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
      ((setq res (_kpblc-conv-ent-to-ename ent_value))
       (vlax-ename->vla-object res)
       )
      ) ;_ end of cond
    ) ;_ end of defun

;|Функция Kr_nentsel
*** Автор Морозов С.В. aka Krieger ***
Еденичный выбор подобъекта, замена функции nentsel
Возвращает entity name выбранного примитива или nil, точку указки запоминает в переменной LASTPOINT
Параметры:
promt - предложение выбрать объект (string)
filter - фильтр объектов для выбора вида '("LINE" "LWPOLYLINE")
entlist - список примитивов которые не надо выбирать (либо список entity name, либо PICKSET)

Примеры:
(Kr_nentsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") nil)
(entget (Kr_nentsel "\nВыберите объекты" nil nil))
(if (setq a (Kr_nentsel "\nВыберите объекты" '("ATTRIB") nil)) (entget a))
(setq aa nil) (Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a)))))
(Kr_enntsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (ssget))

|;

(defun Kr_nentsel (promt filter entlist / key n newentlist ent_point promt)
  
  (setq key T n 0 newentlist nil)
  (if (eq (type entlist) 'PICKSET)
    (progn
    	(while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
    	(setq entlist newentlist)
    );progn
   );if
    (while key
    	(if (or (setq ent_point (nentsel promt)) (= (getvar "ERRNO") 7))
	  	(if (or (eq (type ent_point) 'LIST) (not ent_point))
		  (if ent_point
		    (if (member (setq ent (car ent_point)) entlist)
		      (princ "\nПримитив уже выбран")
		      (if filter
			      (if (not (member (cdr (assoc 0 (entget ent))) filter))
				(progn (setq str "\nНе верный выбор, выберите: ")
				  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
				);progn
				(setq key nil)
			      );if
				(setq key nil)
			);if
		    );if
		    (setq key T)
		  );if
	    	(setq key nil)
	    );if
	  (setq key nil)
      	);if
     );while
  (if (eq (type ent_point) 'LIST)
    (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
    ent_point
  );if
);defun

;|Функция Kr_entsel
*** Автор Морозов С.В. aka Krieger ***
Еденичный выбор объекта, замена функции entsel
Возвращает entity name выбранного примитива или nil, точку указки запоминает в переменной LASTPOINT
Параметры:
promt - предложение выбрать объект (string)
filter - фильтр объектов для выбора вида '("LINE" "LWPOLYLINE")
entlist - список примитивов которые не надо выбирать (либо список entity name, либо PICKSET)

Примеры:
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") nil)
(Kr_entsel "\nВыберите объекты" nil nil)
(setq aa nil) (Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a)))))
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (ssget))

|;

(defun Kr_entsel (promt filter entlist / key n newentlist ent_point promt)
  
  (setq key T n 0 newentlist nil)
  (if (eq (type entlist) 'PICKSET)
    (progn
    	(while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
    	(setq entlist newentlist)
    );progn
   );if
    (while key
    	(if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
	  	(if (or (eq (type ent_point) 'LIST) (not ent_point))
		  (if ent_point
		    (if (member (setq ent (car ent_point)) entlist)
		      (princ "\nПримитив уже выбран")
		      (if filter
			      (if (not (member (cdr (assoc 0 (entget ent))) filter))
				(progn (setq str "\nНе верный выбор, выберите: ")
				  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
				);progn
				(setq key nil)
			      );if
				(setq key nil)
			);if
		    );if
		    (setq key T)
		  );if
	    	(setq key nil)
	    );if
	  (setq key nil)
      	);if
     );while
  (if (eq (type ent_point) 'LIST)
    (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
    ent_point
  );if
);defun

;|Функция Kr_roundof
Округление числа с заданным множителем.
num - число для округления (вводить вещественное число)
presc - множитель

Примеры
(Kr_roundof 45985. 3) 45984.0 
(Kr_roundof -45.56 3) -45.0 
(Kr_roundof 459. 5) 460.0
(Kr_roundof 459 5) 455.0 
(Kr_roundof 4.3 1.2) 4.8
(Kr_roundof 0.1 1.2) 0.0
|;
(defun Kr_roundof (num presc / )
(* (atof (rtos (/ num presc) 2 0)) presc)
  )

Boxa · 13.12.2019, 11:52

Krieger, и сейчас окажется, что Mozgolom, пишет на VBA...

12.12.2019, 18:53		#1
Выбор примитивов или блоков из общей кучи выбранных элементов чертжа. Mozgolom Регистрация: 19.06.2012 Сообщений: 30 Подскажите, как можно реализовать следующее. Выбираю мышкой некую область на чертеже. Соответственно, выбираются все примитивы и блоки, которые попали в данную область. А теперь нужно отфильтровать их, то есть из общей кучи выбрать только определенные блоки, или определенные примитивы. Необходимо быстро массово выбрать определенные объекты из оющей кучи и удалить их.
Просмотров: 2332

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Выбор нескольких элементов одновременно для задания жесткостей	john222	SCAD	10	25.11.2019 22:54
Выбор компьютера для Автокада при работе с большим количеством динамических блоков.	Red Nova	Компьютерная и бытовая техника, электроника и инструмент	12	18.11.2016 11:43
Не сохраняется положение примитивов в редакторе блоков	ramber	AutoCAD	3	06.04.2012 18:17
Создание блоков из примитивов	gest	AutoCAD	11	26.11.2009 10:57
Выбор блоков по значению слоя атрибута	Serge_Y	Программирование	2	15.11.2006 22:43