Достать "формулу" из ячейки таблицы autocad

tsetse · 11.12.2018, 21:08

Добрый день! Возникла следующая проблема. Имеется таблица, в одной из ее ячеек, например A5, вписана формула =A3+A4. Возникла необходимость "достать данную формулу. Стандартный метод vla-getText возвращает число, а не формулу "=A3+A4". Можно ли как-то это побороть?
12.12.2018
Вот что получилось в результате

Код:

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

 (defun C:PCS ( / cellset)
; Функция "складывает" ячейки таблицы и записывает в выбранную
(vl-load-com)
(setq pt nil)
(setq cellset "=")
(setq findedcell nil)
(setq row nil)
(setq col nil)
(setq tblobj nil)
; Запрашиваем ячейки, которые нужно добавить в цикле
(while
	; Запрашиваем точку внутри ячейки
	(setq pt (getpoint "\n Укажите ячейки таблицы, которые нужно сложить:"))
	; получаем row и col в буквенном формате а также указатель на таблицу tblobj
	(GET_CELL_ID pt)
	; добавляем элемент в строку, которую потом впишем	
	(setq cellset (strcat cellset findedcell "+" ))
	(setq findedcell nil)
	(setq row nil)
	(setq col nil)
) ; end of while
; Удаляем последний знак плюс из cellset
(progn
	(setq cellsetlen (strlen cellset))
	(setq cellsetlen (- cellsetlen 1))
	(setq cellset (substr cellset 1 cellsetlen))
	(setq cellsetlen nil)
) ; end of progn
; Запрашиваем ячейку, в которую вписать сумму
(setq pt (getpoint "\n Укажите ячейку таблицы, в которую вписать сумму:"))
; получаем row и col в буквенном формате а также указатель на таблицу tblobj
(GET_CELL_ID pt)
; получаем содержимое заполняемой ячейки
(CELL_FIELD row col tblobj)
; Записываем в ячейку строку-формулу
(vla-SetText tblobj row col cellset)
(setq row nil)
(setq col nil)
(setq tblobj nil)
) ; end of defun

;________________________________________________________________________________


(defun C:PCSA ( / cellset)
; Функция "добавляет" к указанной ячейке таблицы выбранные
(vl-load-com)
(setq pt nil)
(setq cellset "=")
(setq findedcell nil)
(setq row nil)
(setq col nil)
(setq tblobj nil)
(setq row1 nil)
(setq col1 nil)
(setq tblobj1 nil)
(setq field_string nil)
; Запрашиваем точку внутри ячейки к которой добавляем
(setq pt (getpoint "\n Укажите ячейку таблицы, к которой добавляем:"))
; получаем row и col в буквенном формате а также указатель на таблицу tblobj
(GET_CELL_ID pt)
(setq tblobj1 tblobj)
(setq row1 row)
(setq col1 col)
(setq row nil)
(setq col nil)
(setq tblobj nil)
; получаем содержимое заполняемой ячейки
(setq field_string "")
(CELL_FIELD row1 col1 tblobj1)
; Запрашиваем ячейки, на которые домножаем
; Запрашиваем ячейки, которые нужно добавить в цикле
(while
	; Запрашиваем точку внутри ячейки
	(setq pt (getpoint "\n Укажите ячейки таблицы, которые нужно добавить:"))
	; получаем row и col в буквенном формате а также указатель на таблицу tblobj
	(GET_CELL_ID pt)
	; добавляем элемент в строку, которую потом впишем	
	(setq cellset (strcat cellset findedcell "+" ))
	(setq findedcell nil)
	(setq row nil)
	(setq col nil)
) ; end of while
; собираем новый текст
(setq txtnew (strcat cellset "(" field_string ")"))
(vla-SetText tblobj1 row1 col1 txtnew)
(setq row1 nil)
(setq col1 nil)
(setq tblobj1 nil)
(setq row nil)
(setq col nil)
(setq tblobj nil)
) ; end of defun

;________________________________________________________________________________


(defun C:PCM ( / cellset)
; Функция "перемножает" выбранные ячейки таблицы и записывает в выбранную
(vl-load-com)
(setq pt nil)
(setq cellset "=")
(setq findedcell nil)
(setq row nil)
(setq col nil)
(setq tblobj nil)
; Запрашиваем ячейки, которые нужно добавить в цикле
(while
	; Запрашиваем точку внутри ячейки
	(setq pt (getpoint "\n Укажите ячейки таблицы, которые нужно перемножить:"))
	; получаем row и col в буквенном формате а также указатель на таблицу tblobj
	(GET_CELL_ID pt)
	; добавляем элемент в строку, которую потом впишем	
	(setq cellset (strcat cellset findedcell "*" ))
	(setq findedcell nil)
	(setq row nil)
	(setq col nil)
) ; end of while
; Удаляем последний знак * из cellset
(progn
	(setq cellsetlen (strlen cellset))
	(setq cellsetlen (- cellsetlen 1))
	(setq cellset (substr cellset 1 cellsetlen))
	(setq cellsetlen nil)
) ; end of progn
; Запрашиваем ячейку, в которую вписать произведение
(setq pt (getpoint "\n Укажите ячейку таблицы, в которую вписать произведение:"))
; получаем row и col в буквенном формате а также указатель на таблицу tblobj
(GET_CELL_ID pt)
; получаем содержимое заполняемой ячейки
(CELL_FIELD row col tblobj)
; Записываем в ячейку строку-формулу
(vla-SetText tblobj row col cellset)
(setq row nil)
(setq col nil)
(setq tblobj nil)
) ; end of defun

;________________________________________________________________________________

(defun C:PCMA ( / cellset)
; Функция "домножает" указанную ячейку таблицы на выбранные
(vl-load-com)
(setq pt nil)
(setq cellset "=")
(setq findedcell nil)
(setq row nil)
(setq col nil)
(setq row1 nil)
(setq col1 nil)
(setq tblobj nil)
(setq tblobj1 nil)
(setq field_string nil)
; Запрашиваем точку внутри ячейки которую домножаем
(setq pt (getpoint "\n Укажите ячейку таблицы, которую нужно домножить:"))
; получаем row и col в буквенном формате а также указатель на таблицу tblobj
(GET_CELL_ID pt)
(setq tblobj1 tblobj)
(setq row1 row)
(setq col1 col)
(setq row nil)
(setq col nil)
(setq tblobj nil)
; получаем содержимое заполняемой ячейки
(setq field_string "")
(CELL_FIELD row1 col1 tblobj1)
; Запрашиваем ячейки, на которые домножаем
(while
		(setq pt (getpoint "\n Укажите ячейки таблицы, на которые нужно домножить:")) 
		(GET_CELL_ID pt)
		(setq cellset (strcat cellset findedcell "*" ))
		(setq findedcell nil)
) ; end of while
; собираем новый текст
(setq txtnew (strcat cellset "(" field_string ")"))

(vla-SetText tblobj1 row1 col1 txtnew)
(setq row1 nil)
(setq col1 nil)
(setq tblobj1 nil)
(setq row nil)
(setq col nil)
(setq tblobj nil)
) ; end of defun

; Ниже приведены вспомогательные функции
;________________________________________________________________________________

; Функция получения objectID
; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
(defun Get-ObjectID-x86-x64 (obj / util)
	(setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
	(if	(= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
		(if	(= (type obj) 'VLA-OBJECT)
     		(if	(> (vl-string-search "x64" (getvar "platform")) 0)
			(vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
			(rtos (vla-get-objectid obj) 2 0)
		)
	)
)

;________________________________________________________________________________

; Функция преобразования кода ячейки таблицы к строковому формату
; Terry Miller (Email: [email protected])
(defun Number2Alpha (Num# / Val#)
	(if (< Num# 27)
		(chr (+ 64 Num#))
		(if (= 0 (setq Val# (rem Num# 26)))
			(strcat (Number2Alpha (1- (/ Num# 26))) "Z")
			(strcat (Number2Alpha (/ Num# 26)) (chr (+ 64 Val#)))
		);if
	);if
)

;________________________________________________________________________________

; Функция определения кода ячейки
; VVA forum.dwg.ru
(defun GET_CELL_ID (pt)
(if	
	(and
		(setq tblobj nil
			tblset nil
			tblset (ssget "_X" '((0 . "ACAD_TABLE")))
		) ;_ end of setq
		(setq lst
			(mapcar 'vlax-ename->vla-object
				(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))
			) ;_ end of mapcar
		) ;_ end of setq
		(mapcar
			'(lambda (x)
				(or tblobj
					(and
						(= :vlax-true
							(vla-HitTest
								x
								(vlax-3d-point (trans pt 1 0))
								(vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
								'row
								'col
							) ;_ end of vla-HitTest
		   				) ;_ end of =
		   				(setq tblobj x)
					) ;_ end of and
				) ;_ end of or
			) ;_ end of lambda
			lst
		) ;_ end of mapcar
		tblobj
		row
		col
	) ;_ end of and
	; конвертируем числовой формат кода ячейки в буквенный
	(setq findedcell (strcat (vl-princ-to-string (Number2Alpha (1+ col)))(vl-princ-to-string (1+ row))))
	(alert "Мимо!")
) ; end of if
)

;________________________________________________________________________________

; Функция получения значения ячейки или значения ее поля
; koMon  forum.dwg.ru
(defun CELL_FIELD (#row #col #tbl / fieldlen field_id)
; определяем id поля в выбранной ячейке #row #col таблицы #tbl
(setq field_id (vla-getfieldid #tbl #row #col))
; если field_id=0 (содержимое не поле, то читаем текст, иначе читаем поле
(if (= 0 field_id)
(setq field_string (vla-getText #tbl #row #col))
(progn
(setq field_string 
	(cdr 
		(assoc 2 
			(entget 
				(cdr 
					(assoc 360 
						(entget 
							(vlax-vla-object->ename
								(vla-objectidtoobject
									(vla-get-activedocument (vlax-get-acad-object))
								field_id)
							)
						)
					)
				)
			)
		)
	)
) ; end of seq
(setq fieldlen (strlen field_string))
(setq fieldlen (- fieldlen 8))
; удаляем лишние символы
(setq field_string (substr field_string 9 fieldlen))
) ; end progn
) ; end if
) ; end defun

Вспомогательные функции брал с этого форума.
Lisp работает на стандартный таблицах автокада и добавляет 4 функции
PCS - при запуске просит "пощелкать" по ячейкам, которые мы хотим сложить, затем enter и выбираем, в какую ячейку вписать "формулу". При этом значение ячейки переписывается на "формулу"
PCSA - при запуске просит выбрать ячейку, к которой мы хотим добавить. Затем "щелкаем по ячейкам которые добавляем. При этом значение выбранной вначале ячейки увеличивается на "формулу".
Аналогично
PCM - перемножение ячеек
PCMA - домножение содержимого.
При запуске рекомендую выключать объектные привязки
Вспомогательная функция Get-ObjectID-x86-x64 лежит тут для светлого будущего, когда ячейки лежат в разных таблицах.
Жду критики и советов.
Спасибо всем, кто был активен в данной теме!

CalcProg · 16.12.2018, 15:31

-мальчик возьми молоток и забей гвоздь.
-что такое гвоздь и как выглядит молоток?

tsetse · 16.12.2018, 16:12

Цитата:

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

-мальчик возьми молоток и забей гвоздь.
-что такое гвоздь и как выглядит молоток?

В моем случае еще добавить "что такое забей?")

----- добавлено через ~2 мин. -----

Цитата:

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

Можно. Используй vl-remove / vl-remove-if / vl-remove-if-not и анализируй результат.

Спасибо! Изучаю!

CalcProg · 16.12.2018, 18:18

а книги читать не пробовал?
например: AutoLISP... - Полещук Н. Н., Лоскутов П.В. или САПР на базе AutoCAD - Зуев С. Полещук Н.

VVA · 23.12.2018, 08:48

Цитата:

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

Как достать второй элемент?

Цитата:

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

Используй ... vl-remove-if-not и анализируй результат

Код:

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

(defun ru-list-massoc (key alist)
;;; Пример:(ru-list-massoc 10 (entget (car (entsel))))
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist))
) ;_ end of defun

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Создание поля (field), ссылающегося на текстовое значение ячейки таблицы.	skkkk	Готовые программы	141	24.11.2023 15:49
Перенести данные с таблицы AutoCad в Eccess	Jeneva	AutoCAD	2	23.06.2017 10:11
В ячейке одной таблицы есть текст, как сделать чтоб этот текст отображался в ячейки другой таблицы?	Basily	AutoCAD	2	05.02.2017 16:46
Как программно узнать координаты ячейки таблицы (для LISP)?	kp+	LISP	0	15.02.2016 11:41
Блокирование высоты ячейки таблицы Autocad	casaatik	AutoCAD	3	15.09.2011 15:40

	Реклама i