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

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

Lisp. авто-нумерация атрибута блока.

Ответ
Поиск в этой теме
Непрочитано 23.10.2014, 01:25 #1
Lisp. авто-нумерация атрибута блока.
DonJad
 
Murmansk
Регистрация: 20.12.2005
Сообщений: 107

Давным давно нашел здесь на DWG один чудесный лисп:

Код:
[Выделить все]
 (defun C:KlampNum (/ *error* adoc att_list axss blk_list fpt num oaq oat oqa osm sort_list spt test_list cm) 
  (vl-load-com) 
  (defun *error* (error) 
    (cond ((not error)) 
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) 
          (1 (princ (strcat "\nERROR: " error)))) 
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode") 
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  (setq fpt (getpoint "\nПервый угол рамки выбора >> \n") 
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) 
    (if (ssget "_W" fpt spt (list (cons 0 "INSERT") (cons 2 "Klamp") (cons 66 1))) 
      (progn (initget 4) 
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) 
        (if (not num) (setq num (if *last_number* *last_number* 
                            (getint "\n\t >> Первый раз номер задается обязательно  : ")))) 
        (setq axss (vla-get-activeselectionset adoc)) 
        (vlax-for a axss (setq blk_list (cons a blk_list))) 
        (initget "Вперед Назад") 
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) 
        (if (null dir) (setq dir "Вперед")) 
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) 
              sort_list (vl-sort blk_list '(lambda (e1 e2) 
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) 
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) 
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq 
        (foreach blk_obj sort_list 
          (if (and (vlax-property-available-p blk_obj 'Hasattributes) 
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj)) 
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
              (foreach at att_list 
                (if (eq (vla-get-tagstring at) "NUM") 
                  (progn (vla-put-textstring at (itoa num)) 
                    (vla-update at) (vla-update blk_obj))))));if 
          (setq num (1+ num)));foreach 
        (vla-clear axss) (vla-delete axss) 
        (vlax-release-object axss) (setq axss nil) 
        (setq blk_list nil)));if 
  (setq *last_number* num) 
  (vla-regen adoc acactiveviewport) 
  (*error* nil) 
  (princ) 
);end 
(prompt "\n Нумерация блока Klamp, в командной строке набери KlampNum \n") 
(princ)
Сам в Лиспе не силён, но эта штука сподвигла поучиться.

В данной модификации меняет значение атрибута NUM в выбранных вхождениях блока Klamp.
Функция очень спасает. Но хочется её немного улучшить. Добавить возможность выбора блока на лету. Т.е. в процессе выполнения функции добавить вариант выбора текущего блока.

сначала добавил вариант когда пользователь просто вводит желаемое имя блока.
Код:
[Выделить все]
   (setq blockName(getstring T "\n Enter block name: "))
но это скучно, не интересно, да и лень каждый раз имя забивать.


Соответственно ковыряюсь в лиспе дальше, пока не придумал ничего лучше чем вот такое:
Код:
[Выделить все]
   
  (setq next t); добавляем буль для цикла
  (while next ;запускаем цикл
  (initget "Block Блок B Б B B B B");добавляем пользователю выбор
  (setq fpt (getpoint "\nПервый угол рамки выбораa [Блок] >> \n") ; соответственно теперь пользователь может ввести B либо выбрать точку
               spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) ; вторая точка
	(cond ; тут мы добавляем обработчик для исключения, либо выполняем команду по старому.
	((= fpt "B")(setq blocName (entget (entsel "\nPick Block with NUM attribute >> \n"))));тут я хочу чтобы пользователь выбрал объёкт, и если это блок
                       ;;; то его имя будет записано в переменную blockName
        ((listtp fpt) ; если точка, то идем по стандартной функции.
          (if (ssget "_W" fpt spt (list (cons 0 "INSERT") (cons 2 blcName) (cons 66 1))) 
соответственно вопрос, как с помощью entget получить имя блока из вхождения блока выбранного пользователем.

Спасибо!
__________________
Tekla support

Последний раз редактировалось DonJad, 23.10.2014 в 10:44.
Просмотров: 6855
 
Непрочитано 23.10.2014, 01:35
1 | #2
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,843


Цитата:
Сообщение от DonJad Посмотреть сообщение
как с помощью entget получить имя блока из вхождения блока выбранного пользователем
Если именно через entget то (cdr (assoc 2 ...)), но на динамический блок вернет имя автоматически созданного вхождения, а не описания блока, так что возможно потребуется (vla-get-effectivename ...) - через dxf его копать долго да и незачем.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Автор темы   Непрочитано 23.10.2014, 01:45
#3
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 107


Цитата:
Сообщение от Дима_ Посмотреть сообщение
Если именно через entget то (cdr (assoc 2 ...)), но на динамический блок вернет имя автоматически созданного вхождения, а не описания блока, так что возможно потребуется (vla-get-effectivename ...) - через dxf его копать долго да и незачем.

Я их для динамики и не использую так, что подойдёт и entget.

однако, если правильно понял должно быть как-то так:

(setq blcName (cdr (assoc 2 (entget (entsel "\nPick Block with NUM attribute >> \n")))))


но даёт ошибку:
; error: bad argument type: lentityp (<Entity name: 7ffffb70dd0> (-749.643
484.27 0.0))
__________________
Tekla support
DonJad вне форума  
 
Непрочитано 23.10.2014, 03:06
#4
nolte

спринклеры, сантехника
 
Регистрация: 26.01.2010
Сообщений: 188
Отправить сообщение для nolte с помощью Skype™


Автокад выдал подсказку

lentityp (<Entity name: 7ffffb70dd0> (-749.643
484.27 0.0

Entsel возвращает список, состоящий из примитива и координаты точки куда тыркнули, а entget-y требуется только примитив.
__________________
Знание лисп: со справочником Н. Полещука
nolte вне форума  
 
Непрочитано 23.10.2014, 06:30
#5
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


car забыл.
Profan вне форума  
 
Автор темы   Непрочитано 23.10.2014, 10:41
#6
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 107


Ура! Получилось. Спасибо. Теперь следущий вопрос. Что-то я с функцией cond натворил, и судя по всему что-то не то:

Код:
[Выделить все]
 
(defun blName ()
(cdr (assoc 2 (entget (car (entsel "\nPick Block with NUM attribute >> \n")))))
)

(defun C:NumTest (/ *error* adoc att_list axss blk_list next fpt num blockName oaq oat oqa osm sort_list spt test_list cm) 
  (vl-load-com) 
  (defun *error* (error) 
    (cond ((not error)) 
          ((wcmatch (strcase error) "*QUIT*,*CANCEL*")) 
          (1 (princ (strcat "\nERROR: " error)))) 
    (setvar "osmode" osm)  (setvar "attdia" oat) 
    (setvar "attreq" oaq) (setvar "qaflags" oqa) 
    (setvar "cmdecho" 1) (vla-endundomark adoc) 
    (princ));defun 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (vla-endundomark adoc) 
  (vla-startundomark adoc) 
  (setvar "cmdecho" 0) 
  (setq oat (getvar "attdia") osm (getvar "osmode") 
        oaq (getvar "attreq") oqa (getvar "qaflags")) 
  (setvar "attdia" 0);Выводятся запросы в командной строке (окно подавляется) 
  (setvar "attreq" 0);Для каждого атрибута не выдается запрос значения    
  (setvar "qaflags" 0);Запрет вывода на экран окон предупреждений, перенос их в командную строку  
  (setvar "osmode" 0) 
  
  (setq next t);переменная для цикла в true
  (while next
	(initget "Block B B B")
	(setq fpt (getpoint "\nПервый угол рамки выбора [Block] >> \n")) 
	(cond ;обработчик типа  case

	((= fpt "B")(setq blockName (blName)));подхватываем имя блока
	((list fpt)	   ;нумеруем блоки
    ( (setq spt (getcorner fpt "\nВторой угол рамки выбора >> \n")) 
	(if (ssget "_W" fpt spt (list (cons 0 "INSERT") (cons 2 blockName) (cons 66 1))) 
      (progn (initget 4) 
        (setq num (getint "\n\t >> Начальный номер [Enter для продолжения] : ")) 
        (if (not num) (setq num (if *last_number* *last_number* 
                            (getint "\n\t >> Первый раз номер задается обязательно  : ")))) 
        (setq axss (vla-get-activeselectionset adoc)) 
        (vlax-for a axss (setq blk_list (cons a blk_list))) 
        (initget "Вперед Назад") 
        (setq dir (getkword "\nНаправление [Вперед/Назад]: <Вперед>")) 
        (if (null dir) (setq dir "Вперед")) 
        (if (= dir "Вперед") (setq cm <) (setq cm >))  
        (setq test_list (mapcar '(lambda (x) (vlax-get x 'Insertionpoint)) blk_list) 
              sort_list (vl-sort blk_list '(lambda (e1 e2) 
                          (if (vl-every '(lambda (x) (equal (cadr x) (cadar test_list) 0.1)) test_list) 
                            (cm (abs (- (car fpt) (car (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (car fpt) (car (vlax-get e2 'Insertionpoint))))) 
                            (cm (abs (- (cadr fpt) (cadr (vlax-get e1 'Insertionpoint)))) 
                               (abs (- (cadr fpt) (cadr (vlax-get e2 'Insertionpoint)))))))));setq 
        (foreach blk_obj sort_list 
          (if (and (vlax-property-available-p blk_obj 'Hasattributes) 
                   (vlax-read-enabled-p blk_obj) (vlax-write-enabled-p blk_obj)) 
            (progn (setq att_list (vlax-invoke blk_obj 'Getattributes)) 
              (foreach at att_list 
                (if (eq (vla-get-tagstring at) "NUM") 
                  (progn (vla-put-textstring at (itoa num)) 
                    (vla-update at) (vla-update blk_obj))))));if 
          (setq num (1+ num)));foreach 
        (vla-clear axss) (vla-delete axss) 
        (vlax-release-object axss) (setq axss nil) 
        (setq blk_list nil)));if 
		(setq *last_number* num) 
		(vla-regen adoc acactiveviewport) 
		)
		);cond list end
		((null fpt)(setq next nil));выход из цикла в случае если нет значений в первой точке. 
		);end cond
		);end while
		
  (*error* nil) 
  (princ) 
);end 
(prompt "\n Нумерация блока Variable, в командной строке набери NumTest \n") 
(princ)
выдает ошибку:
NumberTest2.lsp successfully loaded.
Command: ; error: malformed list on input

UPD: Исправил. Спасибо Klo.

Но теперь при запуске при вводе первой точки (fpt) в любых вариантах дает ошибку: ERROR: bad point argument
__________________
Tekla support

Последний раз редактировалось DonJad, 23.10.2014 в 11:06.
DonJad вне форума  
 
Непрочитано 23.10.2014, 10:54
1 | #7
Klo

Инженер-конструктор
 
Регистрация: 29.10.2007
Юбилейный МО
Сообщений: 260


Сообщение об ошибке говорит за себя: неправильный список на вводе. То есть где-то потеряна скобка или что-то в этом роде...
Klo вне форума  
 
Непрочитано 23.10.2014, 10:57
#8
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 6,151


http://dwg.ru/dnl/1929
Nike вне форума  
 
Автор темы   Непрочитано 23.10.2014, 11:08
#9
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 107


Цитата:
Сообщение от Nike Посмотреть сообщение
Спасибо!
Но лисп мне как-то милее. Заодно хороший повод разобраться.
__________________
Tekla support
DonJad вне форума  
 
Автор темы   Непрочитано 25.10.2014, 02:35
#10
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 107


Код:
[Выделить все]
 (setq fpt(getpoint))
(setq spt(getcorner fpt))
(setq tt (ssget "W" fpt spt '((0 . "INSERT"))))
(setq tt1 (ssget "W" fpt spt '((2 . "*U201"))))
(setq tt2 (ssget "W" fpt spt '((2 . "Shina"))))
(setq tt3 (ssget "W" fpt spt '((2 . "Terminal"))))
Таки столкнулся с динамическими блоками. Если у кого найдется минутка, разъясните, как их получить то?

вот накатал небольшой тест для собственного понимания вопрса.
в tt - помещаются все блоки
в tt1 и tt2 - пытаюсь получить ссылку на динамический блок shina, вхождения которого почему то имеют имя *U201, впрочем и так и эдак возвращается nil.
в tt3 - попадают обычные блоки с названием "terminal"

при этом в tt - вижу и блоки terminal и *U201...
как мне в tt1 или tt2 получить, что-то отличное от nil?
__________________
Tekla support
DonJad вне форума  
 
Непрочитано 26.10.2014, 02:04
#11
nolte

спринклеры, сантехника
 
Регистрация: 26.01.2010
Сообщений: 188
Отправить сообщение для nolte с помощью Skype™


подсмотри тут про работу с блоками.
вот такa вот функция поможет тебе вытащить все блоки (динамические в том числе) с именем определенным.
пример вызова: (test_bl <name block>)
Код:
[Выделить все]
 
(defun test_bl (nam / lst)
(vl-load-com)
(setq doc(vla-get-activedocument(vlax-get-acad-object)))
(vlax-for lay (vla-get-layouts doc)
	(vlax-for i (vla-get-block lay)
		(if(eq(vla-get-effectivename i) nam)(setq lst(cons i lst)))
	)
)
lst
)
правда на выходе ты получишь список VLA-OBJECT's блоков.

или это должно работать тоже
Код:
[Выделить все]
 
(defun test_b2 (nam / i ent sset lst_ent)
(setq sset(ssget "_W" (getpoint)(getpoint)(list(cons 0 "INSERT"))))
(repeat (setq i(sslength sset))
	(setq ent(ssname sset (setq i(1- i))))
	(if
		(or
			(= (cdr(assoc 2 (entget ent))) nam)
			(=(cdr(assoc 2 (tblnext "BLOCK" (cdr(assoc 2 (entget ent)))))) nam)
		)
		(setq lst_ent(cons ent lst_ent))
	)
)
lst_ent
)
__________________
Знание лисп: со справочником Н. Полещука

Последний раз редактировалось nolte, 26.10.2014 в 02:48.
nolte вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp. авто-нумерация атрибута блока.

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Назначение свойств атрибутов блока без attsync Кулик Алексей aka kpblc Программирование 9 15.08.2017 06:32
Проблема с базовой точкой блока и вхождением блока в DXF nogaems Программирование 5 29.08.2013 15:46
Извлечение атрибутов блока и вставка атрибутов в формулу andery AutoCAD 38 15.06.2009 02:39
Редактирование блока, используя значение его атрибутов Mazai Программирование 14 19.01.2009 20:49
Изменение характеристик атрибутов в вхождении блока zenon AutoCAD 9 27.11.2008 14:43