Экспорт выделенных слоев в таблицу

theilush · 13.05.2024, 07:58

Здравствуйте! Прошу вашей помощи по следующей задаче: имеются полилинии, которые расположены на разных слоях (имя слоя обозначает имя кабельной линии). Соотвественно все линии подходят к щиту (см. рисунок). Мне необходимо получить табличку с колонками имени и цвета слоя по выделенным полилиниям.

Пробовал через

Код:

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

_DATAEXTRACTION

однако проблема заключается в том, что мне важен порядок вывода слоев: например слева на право и тп

Какие есть варианты для решения данной задачи?

Boxa · 13.05.2024, 09:12

Варианты вполне очевидные...
Либо сюда: https://forum.dwg.ru/forumdisplay.php?f=13
Либо сюда: https://forum.dwg.ru/forumdisplay.php?f=33

Dinoxromniy · 13.05.2024, 09:38

Цитата:

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

мне важен порядок вывода слоев: например слева на право

это понятно

Цитата:

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

и тп

это непонятно

Если нет желания программировать, можно поставить в начале каждой линии блок / точку в этом же слое и снимать ее координаты через _DATAEXTRACTION. Отсортировать в экселе группы по координатам вставки блока / точки - дело секундное, длины можно подтянуть к этим блокам например через функцию СУММПРОИЗВ().

theilush · 13.05.2024, 17:24

Цитата:

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

это понятно

это непонятно

Если нет желания программировать, можно поставить в начале каждой линии блок / точку в этом же слое и снимать ее координаты через _DATAEXTRACTION. Отсортировать в экселе группы по координатам вставки блока / точки - дело секундное, длины можно подтянуть к этим блокам например через функцию СУММПРОИЗВ().

Под "и тп" подразумевается остальные направления: справа на лево, снизу в верх и наоборот

Спасибо за предложенный вариант, но хочу более удобный вариант, где будет возможность выбрать область полилиний и сразу же получить последовательность. Поэтому нужна программа, я в этом немного понимаю, но собрал из нескольких разных липсов один липс, который умеет создавать выноску для имени слоя.
Я думаю взять на основу этот липс, но не понимаю, как реализовать выбор области. Можете скинуть источник, где можно будет найти решение?

Сергей812 · 13.05.2024, 18:49

Цитата:

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

как реализовать выбор области.

функция ssget?

Кулик Алексей aka kpblc · 13.05.2024, 20:02

Цитата:

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

Я думаю взять на основу этот липс

"Этот" - это какой?

theilush · 14.05.2024, 04:11

Цитата:

Сообщение от Кулик Алексей aka kpblc

"Этот" - это какой?

Там ваша функция используется вместе с вызовом команды построения мультивыноски...

На этом я остановился, не получается правильно сформировать список для создания таблицы. Функция append возвращается с ошибкой. Можете, пожалуйста, подсказать, как сделать.

Код:

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

(defun c:LayersToTable (/ coords space pt1) ; localize your variables
   (vl-load-com)
	
   ; must be a list of strings. first list is title, next list is header rows.
   (setq data '(("Table Title")
                ("Name")
               )
   )
   
	(setq sset (ssget))

	(setq n (sslength sset))
	(setq a 0)

	(repeat    n
	   (setq ob1 (ssname sset a))
	   
	   (setq fld (strcat
				"%<\\AcObjProp Object(%<\\_ObjId "
				(vl-princ-to-string
				  (_kpblc-get-objectid-for-field(vlax-ename->vla-object ob1))
				  ) ;_ vl-princ-to-string
				">%).Layer>%"
				) ;_ strcat
		)
		
		(princ fld)
		
		;(setq data (append data ‘(123)))
		;(setq data (cons data fld))
		
	(setq a (+ a 1))
	)
	
   
   ;; Retrieves the current active space you are working in, whether MSPACE or PSPACE
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
   )
   
   ; don't run the function unless a point is acutally selected
   (if (setq pt1 (getpoint "\nSelect Insertion Point: "))
      (JH:list-to-table space data pt1 nil)
   )
   (princ)
)


(defun _kpblc-get-objectid-for-field (obj / hex2dec)
  (defun hex2dec (s / f)
    ;; Код Евгения Елпанова
    (defun f (l s / a)
      (cond ((and s l)
             (f (cons (rem (setq a (+ (* (car l) 16) (car s))) 10) (f (cdr l) (list (/ a 10)))) (cdr s))
             )
            ((> (car s) 9) (f nil (cons (rem (car s) 10) (f nil (list (/ (car s) 10))))))
            (l)
            ((if (not (equal s '(0)))
               s
               nil
               ) ;_ end of if
             )
            ) ;_ end of cond
      ) ;_ end of defun
    (setq s (mapcar (function (lambda (a) (- a 48)))
                    (vl-string->list (vl-string-translate "ABCDEF" ":;<=>?" (strcase s)))
                    ) ;_ end of mapcar
          ) ;_ end of setq
    (apply (function strcat) (mapcar (function itoa) (reverse (f '(0) s))))
    ) ;_ end of defun
  (if (setq obj (cond ((= (type obj) 'vla-object) (vlax-vla-object->ename obj))
                      ((= (type obj) 'ename) obj)
                      ) ;_ end of cond
            ) ;_ end of setq
    (progn (setq obj (vl-princ-to-string obj))
           (hex2dec (vl-string-trim ": >" (substr obj (1+ (vl-string-search ":" obj)))))
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun



;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object.
;; lst - list of lists where each list is a list of items to put into the table
;;      => Can be any data type: string, integer, real, etc.
;;      => if you wish to insert a block in the cell, specify the block name and prefix using "<block>"
;;      => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (a list of 2 or 3 real numbers)
;; tblstyle - Table style to use, or nil to use the current table style
;;      => If table style does not exist, uses current table style


(defun JH:list-to-table (space lst pt tblstyle / blk blks hgt i j lens ncols rows totlen txt vtable)
    (setq ncols  (apply 'max (mapcar 'length lst))
          vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
          blks (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (vla-put-RegenerateTableSuppressed vtable :vlax-true)
    (or tblstyle (setq tblstyle (getvar "ctablestyle")))
    (if (JH:TableStyle-p tblstyle) (vla-put-StyleName vtable tblstyle))
    (repeat (setq i (length lst))
        (setq rows (nth (setq i (1- i)) lst))
        (vla-SetRowHeight vtable i (* 2.5 (vlax-invoke vtable 'GetCellTextHeight i 0)))
        (repeat (setq j (length rows))
            (setq 
                j (1- j)
                txt (vl-princ-to-string (nth j rows))
                hgt (vlax-invoke vtable 'GetCellTextHeight i j)
                lens
                (cons
                    (+
                        (abs
                            (apply '-
                                (mapcar 'car
                                    (textbox
                                        (list
                                            (cons 1 txt)
                                            (cons 40 hgt)
                                            (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
                                        )
                                    )
                                )
                            )
                        )
                        hgt
                    )
                    lens
                )
            )
            (if
                (and
                    (eq (strcase (substr txt 1 7)) "<BLOCK>")
                    (tblsearch "block" (setq blk (substr txt 8)))
                )
                (progn
                    (if (and
                            (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                            (vlax-method-applicable-p vtable 'setblocktablerecordid32)
                        )
                        (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item blks blk)))
                        (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item blks blk)) :vlax-true)
                    )
                    (setq lens (cons hgt (cdr lens)))
                )
                (vla-SetText vtable i j txt)
            )
        )
        (setq totlen (cons lens totlen) lens nil)
    )
    (repeat ncols
        (vla-SetColumnWidth vtable (setq ncols (1- ncols))
            (apply 'max
                (vl-remove nil (mapcar '(lambda (x) (nth ncols x)) totlen))
            )
        )
    )
    (vla-put-RegenerateTableSuppressed vtable :vlax-false)
    vtable
)

;; JH:TableStyle-p --> Jonathan Handojo
;; Checks if a table style exists in the current drawing

(defun JH:TableStyle-p (sty)
    (not
        (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-item
                (list 
                    (vla-item
                        (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object)))
                        "ACAD_TABLESTYLE"
                    )
                    sty
                )
            )
        )
    )
)

name02 · 14.05.2024, 08:30

Вот тут быстренько сделал прогу, которая делает что тебе нужно - выделяешь секущей линией объекты, выбираешь направление определения объектов (слева направо, сверху вниз) и указываешь точку вставки таблицы.
Для запуска ввести CNTBL
Файл с программой - CLNTBL.lsp

Код:

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

 ;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
(defun LM:intersections	(ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
	   (vlax-method-applicable-p ob2 'intersectwith)
	   (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      ) ;_ end of and
    (repeat (/ (length lst) 3)
      (setq rtn	(cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	    lst	(cdddr lst)
      ) ;_ end of setq
    ) ;_ end of repeat
  ) ;_ end of if
  (reverse rtn)
) ;_ end of defun


;;Функция сортировки списка по двум координатам
;;на выходе получаем входной список, но уже отсортированный
;;в соответствующем порядке
(defun DwgsSet_GetSortedBlocksList (source-list sort_type / counter tmp_lst)

  (setq
    sorted-list
     (list)				;список с отсортированными записями о блоках
    counter 0				;счетчик для подсчета (для случая без сортировки)
    tmp_lst (list)			;временный список (используется в случае отстутствия сортировки)
  ) ;_ end of setq

  ;;Теперь надо сортировать итоговый список по значению координаты pt_0
  (cond
    ((= sort_type "bycolumns")
     ;;Сортируем список
     ;;получили сортировку столбцами слева направо, сверх вниз
     (setq list-sort-nums
	    (vl-sort-i source-list
		       (function
			 (lambda (a b)
			   (if
			     ;;если модуль разницы координат X меньше погрешности
			     (<= (abs (- (car a) (car b)))
				 1.0
			     ) ;_ end of <=
			      (> (cadr a) (cadr b)) ;то берему у кого больше Y
			      (< (car a) (car b)) ; иначе у кого меньше X
			   )		;end of IF
			 ) ;_ end of lambda
		       ) ;_ end of function
	    ) ;_ end of vl-sort-i
     ) ;_ end of setq
    )

    ;;Это будет сортировка рядами сверху вниз, слева направо
    ((= sort_type "byrows")
     (setq list-sort-nums
	    (vl-sort-i source-list
		       (function
			 (lambda (a b)	;функция, определяющая условия сортировки     				
			   (if
			     ;;если модуль разницы Y координаты меньше условной погрешности
			     (<= (abs (- (cadr a) (cadr b)))
				 1.0
			     ) ;_ end of <=
			      (< (car a) (car b)) ;то берем того, у кого X меньше
			      (> (cadr a) (cadr b)) ; иначе у кого больше Y
			   )		;end of IF
			 ) ;_ end of lambda
		       ) ;_ end of function
	    ) ;_ end of vl-sort-i
     ) ;_ end of setq
    )
  ) ;_ end of cond

  ;;Полученный сортированный список надо передем вышестоящую функцию
  list-sort-nums

) ;_ end of defun

;;Создание таблицы
(defun InsertBOM_Blocks_DrawTable (l	;список с номерами и названиями листов
				   /		   old_settings	   *ms*		   get-current-settings
					;restore-settings
				   set-new-settings		   i		   row		   col
				   header1	   cell_value	   col_width	   max_row	   bold_boundary
				   normal_boundary
				  )

  ;;Выбор точки вставки таблицы
  (setq	pnt (vl-catch-all-apply
	      (function getpoint)
	      '("\nТочка вставки таблицы <Отказаться>: ")
	    ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq

  (not (vl-catch-all-error-p pnt))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;;		ЗАПОЛНЕНИЕ ШАПКИ ТАБЛИЦЫ
  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  ;;Создание таблицы в определенной точке
  (setq	myTable	(vla-AddTable
		  (lib:get-active-space) ;простраство
		  (vlax-3d-point (trans pnt 1 0)) ;точка вставки
		  (+ (length l) 1)	;количество рядов
		  (length (car l))	;количество столбцов
		  8			;высота строки
		  20			;ширина столбцов
		) ;_ end of vla-AddTable
  ) ;_ end of setq

  ;;Отмена обновления таблицы
  (vla-put-RegenerateTableSuppressed myTable :vlax-true)

  ;;Толщины линий границ
  (setq
    bold_boundary   50			; 0.5 мм
    normal_boundary 18			; 0.18 мм
  ) ;_ end of setq

  ;;Удаляем верхний ряд таблицы
  (vla-DeleteRows myTable 0 1)

  ;;Заполняем шапку таблицы
  (setq col 0)
  (setq row 0)


  ;;Заполнение данных по оборудованию
  (foreach rec l

    (setq col 0)

    (foreach cell_value	rec

      (vla-setText mytable row col cell_value)

      (vla-SetCellTextheight myTable row col 2.5) ; высота текста

      (vla-SetCellGridLineweight
	myTable
	row
	col
	(+ acLeftMask acRightMask)
	bold_boundary
      ) ;_ end of vla-SetCellGridLineweight

      (vla-SetCellGridLineweight
	myTable
	row
	col
	(+ acBottomMask)
	normal_boundary
      ) ;_ end of vla-SetCellGridLineweight
      ;; выравнивание текста

      (vla-SetCellAlignment myTable row col acMiddleCenter)

      (setq col (1+ col))
    ) ;_ end of foreach

    (setq row (1+ row))
  ) ;_ end of foreach

  ;;Устанавливаем нижнюю границу таблицы
  ;;После заполнения всей таблицы надо нижнюю границу сделать жирной
  (setq col 0)
  (repeat (vla-Get-Columns myTable)
    (vla-SetCellGridLineweight
      myTable
      (1- (vla-Get-Rows myTable))
      col
      acBottomMask
      bold_boundary
    ) ;_ end of vla-SetCellGridLineweight

    (vla-SetColumnWidth myTable col 50)

    (setq col (1+ col))
  ) ;_ end of repeat


  ;;Пересчет таблицы (таблица - это блок в словаре файла)
  (vla-RecomputeTableBlock myTable :vlax-true)

  ;;Восстанавливаем обновления таблицы
  (vla-put-RegenerateTableSuppressed myTable :vlax-false)

  (vlax-release-object myTable)

  (vlax-release-object (lib:get-active-space))

  (princ)

) ;_ end of defun

;;Определение текущего пространства
(defun lib:get-active-space ()
  (if (and (zerop (vla-get-activespace
		    (vla-get-activedocument (vlax-get-acad-object))
		  ) ;_ end of vla-get-activespace
	   ) ;_ end of zerop
	   (= :vlax-false
	      (vla-get-mspace
		(vla-get-activedocument (vlax-get-acad-object))
	      ) ;_ end of vla-get-mspace
	   ) ;_ end of =
      ) ;_ end of and 
    (vla-get-paperspace
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-get-paperspace
    (vla-get-modelspace
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-get-modelspace
  ) ;_ end of if
) ;_ end of defun

(defun ay_GetObjectsLayersSortedList (/	a b SS res obj i intersect_pts intersect_objs sorted_objs)

  (if (setq a (getpoint))
    (setq b (getpoint a))
  ) ;_ end of if

  (initget "сВерху сЛева")
  (setq	inpt (getkword
	       "Выберите тип сортировки [сВерху-вниз/сЛева-направо]<Слева-направо>:"
	     ) ;_ end of getkword
  ) ;_ end of setq

  (if (null inpt)
    (setq inpt "сЛева")
  ) ;_ end of if

  (setq	sort_type
	 (cond
	   ((= inpt "сВерху") "byrows")
	   ((= inpt "сЛева") "bycolumns")
	 ) ;_ end of cond
  ) ;_ end of setq


  (if b
    (progn
      (setq SS (ssget "_F" (list a b)))
      ;; Создаем отрезок
      (setq res	(vlax-ename->vla-object
		  (entmakex
		    (list
		      '(0 . "LINE")
		      (cons 10 a)
		      (cons 11 b)
		      '(210 0. 0. 1.)
		    ) ;_ end of list
		  ) ;_ end of entmakex
		) ;_ end of vlax-ename->vla-object

      ) ;_ end of setq
    ) ;_ end of progn
  ) ;_ end of if

  (setq i 0)
  (repeat (sslength SS)
    (setq obj (vlax-ename->vla-object (ssname SS i)))

    (setq intersect_pts
	   (append intersect_pts
		   (LM:intersections obj res acextendnone)
	   ) ;_ end of append
    ) ;_ end of setq

    (setq intersect_objs
	   (append intersect_objs
		   (list
		     (ssname SS i)
		   ) ;_ end of list
	   ) ;_ end of append
    ) ;_ end of setq

    (setq i (1+ i))
  ) ;_ end of repeat

  (vla-Delete res)

  (setq	sorted_objs
	 (mapcar
	   '(lambda (x)
	      (cdr (assoc 8 (entget (nth x intersect_objs))))
	    ) ;_ end of lambda
	   (DwgsSet_GetSortedBlocksList intersect_pts sort_type)
	 ) ;_ end of mapcar
  ) ;_ end of setq

  sorted_objs

) ;_ end of defun


;;Вставка таблицы с именами слоев и цветами слоев объектов
(defun c:CLNTBL (/ layer_names acadDoc layers col_name color_names c_n layer_colors)

  (vl-load-com)

  (setq layer_names (ay_GetObjectsLayersSortedList))

  (setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq layers (vla-get-Layers acadDoc))

  (setq	color_names
	 '(
	   (0 . "Поблоку")
	   (1 . "Красный")
	   (2 . "Желтый")
	   (3 . "Зеленый")
	   (4 . "Голубой")
	   (5 . "Синий")
	   (6 . "Фиолетовый")
	   (7 . "Белый")
	  )
  ) ;_ end of setq


  (setq	layer_colors
	 (mapcar '(lambda (layr)
		    (setq col_name (vla-get-Color (vla-item layers layr)))

		    (if	(setq c_n (assoc col_name color_names))
		      (cdr c_n)
		      col_name
		    ) ;_ end of if
		  ) ;_ end of lambda
		 layer_names
	 ) ;_ end of mapcar
  ) ;_ end of setq


  (InsertBOM_Blocks_DrawTable (list layer_names layer_colors))

  (princ)

) ;_ end of defun

theilush · 14.05.2024, 19:43

Цитата:

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

Вот тут быстренько сделал прогу, которая делает что тебе нужно - выделяешь секущей линией объекты, выбираешь направление определения объектов (слева направо, сверху вниз) и указываешь точку вставки таблицы.

Огромное спасибо Вам, то что нужно! Очень неожиданно было получить готовое решение, спасибо Вам еще раз!

theilush · 31.05.2024, 07:09

В процесс работы появилась необходимость в дополнении Вашей программы:
1. Установка выноски с указанием номера.
2. Экспорт данной таблицы в .csv для формирования читабельного отчета. В большинстве случаев таблица получается слишком широкой и некуда ее пристроить...

Пробовал дополнить самым простым способом - вызовом команд, но при выполнении одной команды вторая "проскакивает" не дожидаясь своей очереди.

Код:

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

(command "_mleader")
(InsertBOM_Blocks_DrawTable (list layer_names layer_colors))
(command "ЭКСПОРТТАБЛ")

Добавлял в команды "pause", но результата это не дало.

Код:

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

(command "_mleader" pause pause)

Прошу поправить мою ошибку,

Цитата:

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

Вот тут быстренько сделал прогу, которая делает что тебе нужно - выделяешь секущей линией объекты, выбираешь направление определения объектов (слева направо, сверху вниз) и указываешь точку вставки таблицы.
Для запуска ввести CNTBL
Файл с программой - Вложение 263059

Код:

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

 ;; Intersections  -  Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
(defun LM:intersections	(ob1 ob2 mod / lst rtn)
  (if (and (vlax-method-applicable-p ob1 'intersectwith)
	   (vlax-method-applicable-p ob2 'intersectwith)
	   (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
      ) ;_ end of and
    (repeat (/ (length lst) 3)
      (setq rtn	(cons (list (car lst) (cadr lst) (caddr lst)) rtn)
	    lst	(cdddr lst)
      ) ;_ end of setq
    ) ;_ end of repeat
  ) ;_ end of if
  (reverse rtn)
) ;_ end of defun


;;Функция сортировки списка по двум координатам
;;на выходе получаем входной список, но уже отсортированный
;;в соответствующем порядке
(defun DwgsSet_GetSortedBlocksList (source-list sort_type / counter tmp_lst)

  (setq
    sorted-list
     (list)				;список с отсортированными записями о блоках
    counter 0				;счетчик для подсчета (для случая без сортировки)
    tmp_lst (list)			;временный список (используется в случае отстутствия сортировки)
  ) ;_ end of setq

  ;;Теперь надо сортировать итоговый список по значению координаты pt_0
  (cond
    ((= sort_type "bycolumns")
     ;;Сортируем список
     ;;получили сортировку столбцами слева направо, сверх вниз
     (setq list-sort-nums
	    (vl-sort-i source-list
		       (function
			 (lambda (a b)
			   (if
			     ;;если модуль разницы координат X меньше погрешности
			     (<= (abs (- (car a) (car b)))
				 1.0
			     ) ;_ end of <=
			      (> (cadr a) (cadr b)) ;то берему у кого больше Y
			      (< (car a) (car b)) ; иначе у кого меньше X
			   )		;end of IF
			 ) ;_ end of lambda
		       ) ;_ end of function
	    ) ;_ end of vl-sort-i
     ) ;_ end of setq
    )

    ;;Это будет сортировка рядами сверху вниз, слева направо
    ((= sort_type "byrows")
     (setq list-sort-nums
	    (vl-sort-i source-list
		       (function
			 (lambda (a b)	;функция, определяющая условия сортировки     				
			   (if
			     ;;если модуль разницы Y координаты меньше условной погрешности
			     (<= (abs (- (cadr a) (cadr b)))
				 1.0
			     ) ;_ end of <=
			      (< (car a) (car b)) ;то берем того, у кого X меньше
			      (> (cadr a) (cadr b)) ; иначе у кого больше Y
			   )		;end of IF
			 ) ;_ end of lambda
		       ) ;_ end of function
	    ) ;_ end of vl-sort-i
     ) ;_ end of setq
    )
  ) ;_ end of cond

  ;;Полученный сортированный список надо передем вышестоящую функцию
  list-sort-nums

) ;_ end of defun

;;Создание таблицы
(defun InsertBOM_Blocks_DrawTable (l	;список с номерами и названиями листов
				   /		   old_settings	   *ms*		   get-current-settings
					;restore-settings
				   set-new-settings		   i		   row		   col
				   header1	   cell_value	   col_width	   max_row	   bold_boundary
				   normal_boundary
				  )

  ;;Выбор точки вставки таблицы
  (setq	pnt (vl-catch-all-apply
	      (function getpoint)
	      '("\nТочка вставки таблицы <Отказаться>: ")
	    ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq

  (not (vl-catch-all-error-p pnt))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;
  ;;		ЗАПОЛНЕНИЕ ШАПКИ ТАБЛИЦЫ
  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


  ;;Создание таблицы в определенной точке
  (setq	myTable	(vla-AddTable
		  (lib:get-active-space) ;простраство
		  (vlax-3d-point (trans pnt 1 0)) ;точка вставки
		  (+ (length l) 1)	;количество рядов
		  (length (car l))	;количество столбцов
		  8			;высота строки
		  20			;ширина столбцов
		) ;_ end of vla-AddTable
  ) ;_ end of setq

  ;;Отмена обновления таблицы
  (vla-put-RegenerateTableSuppressed myTable :vlax-true)

  ;;Толщины линий границ
  (setq
    bold_boundary   50			; 0.5 мм
    normal_boundary 18			; 0.18 мм
  ) ;_ end of setq

  ;;Удаляем верхний ряд таблицы
  (vla-DeleteRows myTable 0 1)

  ;;Заполняем шапку таблицы
  (setq col 0)
  (setq row 0)


  ;;Заполнение данных по оборудованию
  (foreach rec l

    (setq col 0)

    (foreach cell_value	rec

      (vla-setText mytable row col cell_value)

      (vla-SetCellTextheight myTable row col 2.5) ; высота текста

      (vla-SetCellGridLineweight
	myTable
	row
	col
	(+ acLeftMask acRightMask)
	bold_boundary
      ) ;_ end of vla-SetCellGridLineweight

      (vla-SetCellGridLineweight
	myTable
	row
	col
	(+ acBottomMask)
	normal_boundary
      ) ;_ end of vla-SetCellGridLineweight
      ;; выравнивание текста

      (vla-SetCellAlignment myTable row col acMiddleCenter)

      (setq col (1+ col))
    ) ;_ end of foreach

    (setq row (1+ row))
  ) ;_ end of foreach

  ;;Устанавливаем нижнюю границу таблицы
  ;;После заполнения всей таблицы надо нижнюю границу сделать жирной
  (setq col 0)
  (repeat (vla-Get-Columns myTable)
    (vla-SetCellGridLineweight
      myTable
      (1- (vla-Get-Rows myTable))
      col
      acBottomMask
      bold_boundary
    ) ;_ end of vla-SetCellGridLineweight

    (vla-SetColumnWidth myTable col 50)

    (setq col (1+ col))
  ) ;_ end of repeat


  ;;Пересчет таблицы (таблица - это блок в словаре файла)
  (vla-RecomputeTableBlock myTable :vlax-true)

  ;;Восстанавливаем обновления таблицы
  (vla-put-RegenerateTableSuppressed myTable :vlax-false)

  (vlax-release-object myTable)

  (vlax-release-object (lib:get-active-space))

  (princ)

) ;_ end of defun

;;Определение текущего пространства
(defun lib:get-active-space ()
  (if (and (zerop (vla-get-activespace
		    (vla-get-activedocument (vlax-get-acad-object))
		  ) ;_ end of vla-get-activespace
	   ) ;_ end of zerop
	   (= :vlax-false
	      (vla-get-mspace
		(vla-get-activedocument (vlax-get-acad-object))
	      ) ;_ end of vla-get-mspace
	   ) ;_ end of =
      ) ;_ end of and 
    (vla-get-paperspace
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-get-paperspace
    (vla-get-modelspace
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-get-modelspace
  ) ;_ end of if
) ;_ end of defun

(defun ay_GetObjectsLayersSortedList (/	a b SS res obj i intersect_pts intersect_objs sorted_objs)

  (if (setq a (getpoint))
    (setq b (getpoint a))
  ) ;_ end of if

  (initget "сВерху сЛева")
  (setq	inpt (getkword
	       "Выберите тип сортировки [сВерху-вниз/сЛева-направо]<Слева-направо>:"
	     ) ;_ end of getkword
  ) ;_ end of setq

  (if (null inpt)
    (setq inpt "сЛева")
  ) ;_ end of if

  (setq	sort_type
	 (cond
	   ((= inpt "сВерху") "byrows")
	   ((= inpt "сЛева") "bycolumns")
	 ) ;_ end of cond
  ) ;_ end of setq


  (if b
    (progn
      (setq SS (ssget "_F" (list a b)))
      ;; Создаем отрезок
      (setq res	(vlax-ename->vla-object
		  (entmakex
		    (list
		      '(0 . "LINE")
		      (cons 10 a)
		      (cons 11 b)
		      '(210 0. 0. 1.)
		    ) ;_ end of list
		  ) ;_ end of entmakex
		) ;_ end of vlax-ename->vla-object

      ) ;_ end of setq
    ) ;_ end of progn
  ) ;_ end of if

  (setq i 0)
  (repeat (sslength SS)
    (setq obj (vlax-ename->vla-object (ssname SS i)))

    (setq intersect_pts
	   (append intersect_pts
		   (LM:intersections obj res acextendnone)
	   ) ;_ end of append
    ) ;_ end of setq

    (setq intersect_objs
	   (append intersect_objs
		   (list
		     (ssname SS i)
		   ) ;_ end of list
	   ) ;_ end of append
    ) ;_ end of setq

    (setq i (1+ i))
  ) ;_ end of repeat

  (vla-Delete res)

  (setq	sorted_objs
	 (mapcar
	   '(lambda (x)
	      (cdr (assoc 8 (entget (nth x intersect_objs))))
	    ) ;_ end of lambda
	   (DwgsSet_GetSortedBlocksList intersect_pts sort_type)
	 ) ;_ end of mapcar
  ) ;_ end of setq

  sorted_objs

) ;_ end of defun


;;Вставка таблицы с именами слоев и цветами слоев объектов
(defun c:CLNTBL (/ layer_names acadDoc layers col_name color_names c_n layer_colors)

  (vl-load-com)

  (setq layer_names (ay_GetObjectsLayersSortedList))

  (setq acadDoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq layers (vla-get-Layers acadDoc))

  (setq	color_names
	 '(
	   (0 . "Поблоку")
	   (1 . "Красный")
	   (2 . "Желтый")
	   (3 . "Зеленый")
	   (4 . "Голубой")
	   (5 . "Синий")
	   (6 . "Фиолетовый")
	   (7 . "Белый")
	  )
  ) ;_ end of setq


  (setq	layer_colors
	 (mapcar '(lambda (layr)
		    (setq col_name (vla-get-Color (vla-item layers layr)))

		    (if	(setq c_n (assoc col_name color_names))
		      (cdr c_n)
		      col_name
		    ) ;_ end of if
		  ) ;_ end of lambda
		 layer_names
	 ) ;_ end of mapcar
  ) ;_ end of setq


  (InsertBOM_Blocks_DrawTable (list layer_names layer_colors))

  (princ)

) ;_ end of defun

13.05.2024, 07:58		#1
Экспорт выделенных слоев в таблицу theilush Регистрация: 13.05.2024 Сообщений: 5 Здравствуйте! Прошу вашей помощи по следующей задаче: имеются полилинии, которые расположены на разных слоях (имя слоя обозначает имя кабельной линии). Соотвественно все линии подходят к щиту (см. рисунок). Мне необходимо получить табличку с колонками имени и цвета слоя по выделенным полилиниям. Пробовал через Код: [Выделить все] _DATAEXTRACTION однако проблема заключается в том, что мне важен порядок вывода слоев: например слева на право и тп Какие есть варианты для решения данной задачи? Миниатюры
Просмотров: 1469

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Импор та Экспорт слоев та фильтров в отдельный файл.	Publipor	AutoCAD	8	22.03.2022 15:27
Экспорт списка слоев	posetitel	LISP	7	09.04.2018 17:42
Как получить спецификацию (таблицу с характеристиками) выделенных объектов?	Taurustau	AutoCAD	38	12.09.2014 21:54
LISP. Пакетный экспорт настроек слоев	TararykovDG	Готовые программы	4	03.04.2012 10:03
Экспорт фильтров слоев	карма	AutoCAD	2	05.01.2010 05:42