| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Выбирает не тот объект в наборе

Выбирает не тот объект в наборе

Ответ
Поиск в этой теме
Непрочитано 15.10.2019, 09:42 #1
Выбирает не тот объект в наборе
GogMagog
 
Регистрация: 24.08.2011
Сообщений: 39

Уважаемые форумчане! Прошу помощи!
Решил я между делом "покурить" лисп. Попробывал написать следующий макрос:
1. Выбирается нарисованная отрезками таблица спецификации.
2. Все вертикальные отрезки делает толщиной 0,5.
3. Первые два (сверху вниз) горизонтальных отрезка и последний делает толщиной 0,5.

Почему то последний отрезок не меняется а меняется третий сверху
Код:
[Выделить все]
 (defun c:vv ()
  (setq s_p1 (getpoint))
  (setq s_p2 (getcorner s_p1))
;;;  (setq ss_text(ssget "_W" s_p1 s_p2 (list '(1 . "Поз."))));selectoin by text string
  (setq ss_line (ssget "_W" s_p1 s_p2 '((0 . "LINE"))))
					;selection by X1=X2
  (setq ss_line_len (sslength ss_line))
  (setq ss_line_num (- ss_line_len 1))
  (setq ss_vertline (ssadd))		;пока пустой список для вертикальных Х1=Х2
  (setq ss_horline (ssadd))		;пока пустой список для горизонтальных У1=У2

  (while (>= ss_line_num 0)
    (setq a (entget (ssname ss_line ss_line_num)))
    (if	(= (nth 1 (assoc 10 a)) (nth 1 (assoc 11 a)))
      (progn
	(ssadd (ssname ss_line ss_line_num) ss_vertline)
	;(alert "Vertikal!")
      )
      (if (= (nth 2 (assoc 10 a)) (nth 2 (assoc 11 a)))
	(progn (ssadd (ssname ss_line ss_line_num) ss_horline)
	       ;(alert "Horizontal!")
	)
      )

    )					;end if
    (setq ss_line_num (- ss_line_num 1))

  )					;end while
  ;(alert "Complete!")
  (setq ss_vertline_num (-(sslength ss_vertline)1))
  (setq ss_horline_num (-(sslength ss_horline)1))


  ;начало для вертикальных
  (while(>= ss_vertline_num 0)
    (setq a (entget(ssname ss_vertline ss_vertline_num)))
    (if(= (assoc 370 a) nil)
	(progn
	  (setq a (append a (list (cons 370 50))))
	  (entmod a)
	   
	  );end progn
      	(progn
	  
	  (setq a (subst (cons 370 50) (assoc 370 a) a))
	  (entmod a)
	  
	 );end progn
      );end if
    (setq ss_vertline_num(- ss_vertline_num 1))
    );end while
  ;конец для вертикальных

  ;начало для горизонтальных



  
  (setq a (ssname ss_horline ss_horline_num))	
  (setq ss_horline_max (ssadd))
  (setq ss_horline_min(ssadd))
  (ssadd a ss_horline_max)
  (ssadd a ss_horline_min)
  ;начало для максимума
  (while(>= ss_horline_num 0)
    (setq a (ssname ss_horline ss_horline_num))
    (setq y (nth 2 (assoc 10 (entget a))))
   
    (if (> y (nth 2 (assoc 10 (entget (ssname ss_horline_max 0)))))
      (progn(ssdel(entlast)ss_horline_max)	
      (ssadd a ss_horline_max)
)
	);end if
    (setq ss_horline_num (- ss_horline_num 1))
      );end while
     
    (setq b (entget(ssname ss_horline_max (- (sslength ss_horline_max) 1))))
    
;;;  
  (if(= (assoc 370 b) nil)
	(progn
	  (setq b (append b (list (cons 370 50))))
	  (entmod b)
	   
	  );end progn
      	(progn
	  
	  (setq b (subst (cons 370 50) (assoc 370 b) b))
	  (entmod b)
	  
	 );end progn
      );end if
  ;конец для максимума
  ;начало для второй черты
  (ssdel (ssname ss_horline_max 0) ss_horline)
  (setq ss_horline_num (-(sslength ss_horline)1))
  (setq a (ssname ss_horline ss_horline_num))
  (print (entget a))
  (ssadd (entlast)ss_horline_max)
  (ssadd a ss_horline_max)
  (while(>= ss_horline_num 0)
    (setq a (ssname ss_horline ss_horline_num))
    (setq y (nth 2 (assoc 10 (entget a))))
    (print y)
    (print(nth 2 (assoc 10 (entget (ssname ss_horline_max 0)))))
    (if (> y (nth 2 (assoc 10 (entget (ssname ss_horline_max 0)))))
      (progn(ssdel(entlast)ss_horline_max)	
      (ssadd a ss_horline_max)
)
	);end if
    (setq ss_horline_num (- ss_horline_num 1))
      );end while
     
    (setq b (entget(ssname ss_horline_max (- (sslength ss_horline_max) 1))))
    
  
  (if(= (assoc 370 b) nil)
	(progn
	  (setq b (append b (list (cons 370 50))))
	  (entmod b)
	   
	  );end progn
      	(progn
	  
	  (setq b (subst (cons 370 50) (assoc 370 b) b))
	  (entmod b)
	  
	 );end progn
      );end if
;конец для второй черты

  ;начало для последней черты
(ssdel (ssname ss_horline_max 0) ss_horline)
  (setq ss_horline_num (-(sslength ss_horline)1))
  (setq a (ssname ss_horline ss_horline_num))
  (print (entget a))
  (ssadd (entlast)ss_horline_max)
  (ssadd a ss_horline_max)
  (while(>= ss_horline_num 0)
    (setq a (ssname ss_horline ss_horline_num))
    (setq y (nth 2 (assoc 10 (entget a))))
    (print y)
    (print(nth 2 (assoc 10 (entget (ssname ss_horline_max 0)))))
    (if (< y (nth 2 (assoc 10 (entget (ssname ss_horline_max 0)))))
      (progn(ssdel(entlast)ss_horline_max)	
      (ssadd a ss_horline_max)
)
	);end if
    (setq ss_horline_num (- ss_horline_num 1))
      );end while
     
    (setq b (entget(ssname ss_horline_max (- (sslength ss_horline_max) 1))))
    
  
  (if(= (assoc 370 b) nil)
	(progn
	  (setq b (append b (list (cons 370 50))))
	  (entmod b)
	   
	  );end progn
      	(progn
	  
	  (setq b (subst (cons 370 50) (assoc 370 b) b))
	  (entmod b)
	  
	 );end progn
      );end if

  ;конец для последней черты
  ;конец для горизонтальных
  
  ); defun c:vv

Миниатюры
Нажмите на изображение для увеличения
Название: спец на форум.jpg
Просмотров: 17
Размер:	33.9 Кб
ID:	218855  

Просмотров: 971
 
Непрочитано 15.10.2019, 13:23
1 | #2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Код:
[Выделить все]
 (vl-load-com)
(defun t1 (/ selset hor vert)
  (if (= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget "_:L" '((0 . "LINE"))))))))
         'pickset
         ) ;_ end of =
    (progn (setq selset (mapcar (function (lambda (x) (cons (vlax-ename->vla-object x) (entget x))))
                                ((lambda (/ tab item)
                                   (repeat (setq tab  nil
                                                 item (sslength selset)
                                                 ) ;_ end setq
                                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                                     ) ;_ end of repeat
                                   ) ;_ end of lambda
                                 )
                                ) ;_ end of mapcar
                 vert   (mapcar (function car)
                                (vl-remove-if-not (function (lambda (x) (equal (cadr (assoc 10 (cdr x))) (cadr (assoc 11 (cdr x))))))
                                                  selset
                                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                 hor    (mapcar (function car)
                                (vl-sort (vl-remove-if-not (function (lambda (x) (equal (caddr (assoc 10 (cdr x))) (caddr (assoc 11 (cdr x))))))
                                                           selset
                                                           ) ;_ end of vl-remove-if-not
                                         (function (lambda (a b) (> (caddr (assoc 10 (cdr a))) (caddr (assoc 10 (cdr b))))))
                                         ) ;_ end of vl-sort
                                ) ;_ end of mapcar
                 ) ;_ end of setq
           (foreach ent vert (vla-put-lineweight ent aclnwt050))
           (foreach ent (list (car hor) (cadr hor) (last hor)) (vla-put-lineweight ent aclnwt050))
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 15.10.2019, 14:41
#3
GogMagog


 
Регистрация: 24.08.2011
Сообщений: 39


Кулик Алексей aka kpblc спасибо!!
GogMagog вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Выбирает не тот объект в наборе

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как сделать так чтобы OLE объект вставленный в чертеж в качестве подложки не вылелялся? Роман Амосов AutoCAD 5 21.02.2021 19:13
Может ли объект благоустройства территории двора (надстройка на въезде в паркинг), попадать под пожарные нормы? erikbond Технология и организация строительства 0 24.06.2018 12:16
Как через лисп раскопировать объект по существующим точкам? kurstep LISP 5 25.03.2018 01:54
Поскажите, является ли объект линейным? Люля Инженерные сети 4 07.12.2011 19:06