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

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

Lisp для помощи в заполнении кабельного журнала

Ответ
Поиск в этой теме
Непрочитано 05.03.2020, 13:54 #1
Lisp для помощи в заполнении кабельного журнала
dadatamada
 
Регистрация: 26.08.2011
Сообщений: 16

Добрый день.

Помогите допилить lisp (взят здесь https://www.caduser.ru/forum/topic49382.html), на форуме тема заглохла, а lisp очень полезный.
Данный код позволяет брать информацию из текстов. Уважаемые гуру, помогите допилить так, чтобы данный лисп брал информацию не из текста, а из первого атрибута указанного динамического блока.

Код:
[Выделить все]
 
;;---------------------------------------------------------;;
 
;; exhausted by fixo
;; edited 1/26/12   
(defun C:demo (/ cnt col data dirty en next pick row stxt tbl txt vec  xdir ydir zdir)
  
;; local function by gile
(defun CrossProduct (v1 v2)
  (list    (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
    (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
    (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
  )
)
   
  ;;  -------------------   main part   ---------------------;;
 
  (while (not tbl)
    (if    (setq en (entsel "\nВыбрать таблицу:"))
      (progn
    (setq tbl (vlax-ename->vla-object (car en)))
    (if (not (eq "AcDbTable" (vla-get-ObjectName tbl)))
      (progn
        (princ "Выбранный объект не таблица.")
        (setq tbl nil)
      )
    )
      )
      (princ "Ничего не выбрано.")
    )
  )
 
 
         (setq pick (getpoint "\nУказать точку внутри ячейки: "))  
             (setq xdir    (getvar "ucsxdir")
               ydir    (getvar "ucsydir")
               zdir    (CrossProduct xdir ydir))
 
 
             (setq vec (vlax-make-variant
                 (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbDouble '(0 . 2))
                   zdir))
               )
  (if (eq :vlax-true
                 (vla-hittest
                   tbl
                   (vlax-3d-point (trans pick 1 0))
                   vec
                   'row
                   'col))
 
               (vla-setsubselection tbl row row col col)
 
               )
 
  (princ "\n   ---   Выбрать тексты по одному попарно:   ---")
  (setq next T)
  (while (and next (setq stxt (ssget "_:S" (list (cons 0 "*text")))))
    (setq txt (cdr (assoc 1 (entget (ssname stxt 0)))))
    (setq dirty (cons txt dirty))
    )
  (if (/= 0(rem (length dirty) 2))
    (progn
      (alert "Число выбранных текстов не кратно двум. Отбой...")
      (exit)
      (princ)
      )
    )
    (setq dirty (reverse dirty)
      data nil)
  
  (while (cadr dirty)
    (setq data (append (list (list (car dirty) (cadr dirty))) data))
    (setq dirty (cddr dirty))
  )
   
  (setq data (reverse data))
   
 (setq cnt col)
   
  (foreach item data
    (setq col cnt)
    (vl-catch-all-apply 'vla-settext (list tbl row col (car item)))
     
    (setq col (1+ col))
   (vl-catch-all-apply 'vla-settext (list tbl row col (cadr item)))
     
    (setq row (1+ row))
    )
   (vl-catch-all-apply 'vla-clearsubselection (list tbl))
  (vla-update tbl)
  (vlax-release-object tbl)
  (princ)
)
(prompt "\n   ---   команда на выполнение \"DEMO\"   ---")
(prin1)
(or (vl-load-com)
(princ)    )
;;---------------------------------------------------------;;
Просмотров: 2823
 
Непрочитано 05.03.2020, 14:15
#2
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Блок в студию пожалуйста.
tsetse вне форума  
 
Автор темы   Непрочитано 06.03.2020, 07:26
#3
dadatamada


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


Файл с блоком прилагаю. Но необходимо чтобы с любым динамическим блоком работало, т.к. блоков очень много разных. Это характерно для слаботочки.
Вложения
Тип файла: dwg
DWG 2010
ПУ.dwg (54.4 Кб, 44 просмотров)
dadatamada вне форума  
 
Непрочитано 10.03.2020, 08:24
#4
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Представленный лисп тексты обрабатывает парами. В вашем случае что нужно? Первый элемент пары аттрибут динамического блока, а второй текст? Или оба элемента каждой пары аттрибут динамического блока?
tsetse вне форума  
 
Автор темы   Непрочитано 10.03.2020, 09:23
#5
dadatamada


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


Цитата:
Сообщение от tsetse Посмотреть сообщение
Представленный лисп тексты обрабатывает парами. В вашем случае что нужно? Первый элемент пары аттрибут динамического блока, а второй текст? Или оба элемента каждой пары аттрибут динамического блока?
Добрый день. Оба элемента каждой пары первый аттрибут динамического блока.
dadatamada вне форума  
 
Непрочитано 10.03.2020, 09:26
1 | #6
Turpak


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


Цитата:
Сообщение от dadatamada Посмотреть сообщение
Уважаемые гуру, помогите допилить так, чтобы данный лисп брал информацию не из текста, а из первого атрибута указанного динамического блока.
В этом нет нужды, Гуру Petro_f уже допилил и сделал плагин PDKFKG (динамические блоки для кабелей там как пример тоже есть), вот тема с решением https://forum.dwg.ru/showthread.php?t=141086

От себя приложил файл с блоком для оформления однолинеек и последующей прокладкой кабелей вышеописанным плагином.

Если вам просто нужно сделать кабельный журнал по вашим схемам (однолинейкам и т.д.) то советую изучить извлечение данных из чертежей.
Всё, что требуется:
  1. правильно оформить (и впредь оформлять) однолинейки и прочие схемы при помощи блоков с атрибутами;
  2. написать команду "ДАННЫЕИЗВЛ";
  3. выбор типа блока кабельных линий (или нескольких блоков);
  4. настройка количества и положения столбцов (в т.ч. переименование);
  5. вставка таблицей в Акад...
  6. или выгрузка в таблицу эксель.

Во всех остальных случаях советую использовать плагин PDKFKG (там КЖ тоже формируется, только более детально)
Вложения
Тип файла: dwg
DWG 2013
Блоки Каб.Хозяйство.dwg (109.6 Кб, 32 просмотров)
Turpak вне форума  
 
Автор темы   Непрочитано 10.03.2020, 09:39
#7
dadatamada


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


Цитата:
Сообщение от Turpak Посмотреть сообщение
В этом нет нужды, Гуру Petro_f уже допилил и сделал плагин PDKFKG (динамические блоки для кабелей там как пример тоже есть), вот тема с решением https://forum.dwg.ru/showthread.php?t=141086
Спасибо, за помощь, но такое решение не подошло. Плагин данный юзал и сравнивал время для СКС типа звезда - подходит идеально. Но не для моих задач: время на трассировку кабеля данным плагином сравнимо с заполнением кабельного журнала вручную. А этот лисп способен существенно сократить время.

Извлечение данных не подходит, т.к. соединения между различными элементами хаотично, а не закономерно.
dadatamada вне форума  
 
Непрочитано 10.03.2020, 09:55
#8
Turpak


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


Цитата:
Сообщение от dadatamada Посмотреть сообщение
А этот лисп способен существенно сократить время.
Вместо того, что бы пилисть лисп обработки информации - извлекайте информацию штатными функциями Акада. Не надо изобретать велосипед.
  1. правильно оформить при помощи блоков с атрибутами (у вас это сделано, как я понял);
  2. написать команду "ДАННЫЕИЗВЛ";
  3. настройка количества и положения столбцов (в т.ч. переименование);
  4. вставка таблицей в Акад...
  5. или выгрузка в таблицу эксель.

Цитата:
Сообщение от dadatamada Посмотреть сообщение
Извлечение данных не подходит, т.к. соединения между различными элементами хаотично, а не закономерно.
По примеру блока трудно понять, что вам нужно сделать. Рекомендовал бы отдельным блоком промарикровать все связи, потом ивзлечение. Дальше смотрите сами

Последний раз редактировалось Turpak, 10.03.2020 в 09:57. Причина: ответ на дополнение от dadatamada
Turpak вне форума  
 
Непрочитано 10.03.2020, 10:00
1 | #9
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от dadatamada Посмотреть сообщение
Спасибо, за помощь, но такое решение не подошло. Плагин данный юзал и сравнивал время для СКС типа звезда - подходит идеально. Но не для моих задач: время на трассировку кабеля данным плагином сравнимо с заполнением кабельного журнала вручную. А этот лисп способен существенно сократить время.

Извлечение данных не подходит, т.к. соединения между различными элементами хаотично, а не закономерно.
Исходный код с минимальными правками. Добавил подпрограмму get-all-atts с этого форума
Код:
[Выделить все]
  
;;---------------------------------------------------------;;
 
;; exhausted by fixo
;; edited 1/26/12   
(defun C:demo (/ cnt col data dirty en next pick row stxt tbl txt vec  xdir ydir zdir)
  
;; local function by gile
(defun CrossProduct (v1 v2)
  (list    (- (* (cadr v1) (caddr v2)) (* (caddr v1) (cadr v2)))
    (- (* (caddr v1) (car v2)) (* (car v1) (caddr v2)))
    (- (* (car v1) (cadr v2)) (* (cadr v1) (car v2)))
  )
)
   
  ;;  -------------------   main part   ---------------------;;
 
  (while (not tbl)
    (if    (setq en (entsel "\nВыбрать таблицу:"))
      (progn
    (setq tbl (vlax-ename->vla-object (car en)))
    (if (not (eq "AcDbTable" (vla-get-ObjectName tbl)))
      (progn
        (princ "Выбранный объект не таблица.")
        (setq tbl nil)
      )
    )
      )
      (princ "Ничего не выбрано.")
    )
  )
 
 
         (setq pick (getpoint "\nУказать точку внутри ячейки: "))  
             (setq xdir    (getvar "ucsxdir")
               ydir    (getvar "ucsydir")
               zdir    (CrossProduct xdir ydir))
 
 
             (setq vec (vlax-make-variant
                 (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbDouble '(0 . 2))
                   zdir))
               )
  (if (eq :vlax-true
                 (vla-hittest
                   tbl
                   (vlax-3d-point (trans pick 1 0))
                   vec
                   'row
                   'col))
 
               (vla-setsubselection tbl row row col col)
 
               )
 
  (princ "\n   ---   Выбрать тексты по одному попарно:   ---")
  (setq next T)
  (while (and next (setq sblk (ssget "_:S" (list (cons 0 "*INSERT")))))
	(setq sblk (ssname sblk 0))
	(setq stxt (get-all-atts sblk))
	(setq txt (cdr (nth 0 stxt)))
	(setq dirty (cons txt dirty))
    )
  (if (/= 0(rem (length dirty) 2))
    (progn
      (alert "Число выбранных текстов не кратно двум. Отбой...")
      (exit)
      (princ)
      )
    )
    (setq dirty (reverse dirty)
      data nil)
  
  (while (cadr dirty)
    (setq data (append (list (list (car dirty) (cadr dirty))) data))
    (setq dirty (cddr dirty))
  )
   
  (setq data (reverse data))
   
 (setq cnt col)
   
  (foreach item data
    (setq col cnt)
    (vl-catch-all-apply 'vla-settext (list tbl row col (car item)))
     
    (setq col (1+ col))
   (vl-catch-all-apply 'vla-settext (list tbl row col (cadr item)))
     
    (setq row (1+ row))
    )
   (vl-catch-all-apply 'vla-clearsubselection (list tbl))
  (vla-update tbl)
  (vlax-release-object tbl)
  (princ)
)
(prompt "\n   ---   команда на выполнение \"DEMO\"   ---")
(prin1)
(or (vl-load-com)
(princ)    )

;;---------------------------------------------------------;;
(defun get-all-atts (obj)
(vl-load-com)
(if (= (type obj) 'ENAME)
	(setq obj (vlax-ename->vla-object obj)))
	(if
		(and obj
			(vlax-property-available-p obj 'Hasattributes)
			(eq :vlax-true (vla-get-HasAttributes obj))
		)
		(vl-catch-all-apply
      (function
	(lambda	()
	  (mapcar (function (lambda (x)
			      (cons (vla-get-TagString x)
				    (vla-get-TextString x)
			      )
			    )
		  )
		  (append (vlax-invoke obj 'Getattributes)
			  (vlax-invoke obj 'Getconstantattributes)
		  )
	  )
	)
      )
    )
  )
)
tsetse вне форума  
 
Автор темы   Непрочитано 10.03.2020, 10:13
#10
dadatamada


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


Цитата:
Сообщение от tsetse Посмотреть сообщение
Исходный код с минимальными правками. Добавил подпрограмму get-all-atts с этого форума
Спасибо, всё работает. Куда на пиво закинуть, друг?
dadatamada вне форума  
 
Непрочитано 10.03.2020, 10:53
#11
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от dadatamada Посмотреть сообщение
Спасибо, всё работает. Куда на пиво закинуть, друг?
Благодарности достаточно) Обращайтесь)
tsetse вне форума  
 
Непрочитано 16.03.2020, 21:26
#12
petro_f

Проектировщик
 
Регистрация: 06.10.2016
СПб
Сообщений: 299
Отправить сообщение для petro_f с помощью Skype™


Цитата:
Сообщение от dadatamada Посмотреть сообщение
Цитата:
Сообщение от Turpak
В этом нет нужды, Гуру Petro_f уже допилил и сделал плагин PDKFKG (динамические блоки для кабелей там как пример тоже есть), вот тема с решением https://forum.dwg.ru/showthread.php?t=141086
Спасибо, за помощь, но такое решение не подошло. Плагин данный юзал и сравнивал время для СКС типа звезда - подходит идеально. Но не для моих задач: время на трассировку кабеля данным плагином сравнимо с заполнением кабельного журнала вручную. А этот лисп способен существенно сократить время.
Ну при использовании плагина есть свои плюшки (например расчёт заполняемости лотков, веса кабелей на метр, маркировка, автовыгрузка КЖ и пр...)
P.S. Если интересно, могу дать ещё плагин для однолинейных схем и сами блоки однолинеек
__________________
Если ты разговариваешь с идиотом - убедись что он не занят тем же!
petro_f вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp для помощи в заполнении кабельного журнала

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Импорт палитры блоков при помощи LISP TwoZero LISP 13 31.01.2019 17:38
Автоматизация для кабельного журнала, подсчет длин и марок кабеля kosolapi Программирование 22 20.11.2014 09:51
Lisp. Как создать при помощи кода, два файла связанных ссылками Yura Agafonov LISP 11 13.11.2012 11:03
Как генерировать блоки с атрибутами в пространстве модели(листа) при помощи LISP!!! SpillOver LISP 27 08.01.2010 21:36
Как при помощи Lisp добраться до элементов не активного или вообще закрытого листа DWG? back1981 LISP 3 23.10.2009 19:39