LISP. Создание поля (field), ссылающегося на текстовое значение ячейки таблицы.

skkkk · 01.08.2013, 12:14

По многочисленным просьбам трудящихся форумчан и не только их. Возник этот вопрос довольно давно.
Может ли поле принимать текстовое значение ячейки таблицы?
Возможно ли выцепить текст у таблиц? Как это можно реализовать на AutoLISP?
Как вставить полем содержимое ячейки таблицы?
Как должно быть многим известно, в AutoCAD'е не предусмотрена возможность сослаться полем на ТЕКСТОВУЮ ячейку таблицы.
Попытаемся исправить это, на мой взгляд, досадное недоразумение.
Предлагается для обсуждения и тестирования код, который содержит в себе функции из перечисленных выше тем, несколько переработанные и собранные в одну, то есть, в две команды. Отдельное спасибо VVA за весомую помощь в реализации идеи.

Доступные команды:
- TextCellField (или TCF) - создание поля, ссылающегося на указанную ячейку таблицы (текстовую или числовую);
- UpdateTextCellFields (или UTCF) - обновление всех созданных командой TextCellField полей после редактирования исходных ячеек с последующей регенерацией. Как вариант, эту команду можно повесить вместо привычной регенерации. Если полей, созданных командой TextCellField в чертеже нет, то просто произойдет регенерация.

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

Алгоритм:
После указания пользователем двух точек из указанной ячейки (1-я точка) берется содержимое и очищается от форматирования. В Свойствах чертежа (команда _dwgprops), во вкладке Прочее (Custom) создается свойство с именем следующего формата:

Код:

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

Table<handle таблицы>_<адрес ячейки>

Значение этого свойства заполняется строкой, взятой из ячейки, которая может иметь как текстовый, так и числовой формат. Во второй указанной точке создается поле, источником информации для которого служит только что созданное свойство чертежа (значение этого поля становится равным значению ячейки таблицы). Если ячейка пуста, то полю присвоится значение "----".
После того, как пользователь изменит значение в исходной ячейке таблицы, необходимо запустить команду UpdateTextCellFields. Она "пройдется" по всем созданным командой TextCellField свойствам чертежа и назначит каждому актуальное значение "своей" ячейки, затем выполнит регенерацию, присвоив полям новые (если они изменились) значения свойств чертежа. При удалении строк или столбцов из таблицы поле будет продолжать ссылаться на абсолютный адрес ячейки, т.е. если пользователь, например, сослался полем на ячейку A2, а затем удалил вторую строку таблицы, то поле начнет ссылаться на ту ячейку, адрес которой стал A2 (бывший A3). Если ячейка (или вся таблица), на которую ссылались поля, перестала существовать, то свойство чертежа, оставшееся без "своей" ячейки, будет удалено из списка Custom-свойств, и на экран выведется сообщение о количестве недостающих ячеек; "осиротевшие" поля "попадут за решетку". Поэтому удалять строки и столбцы, впрочем как и в случае с "родными" полями, надо осторожно, с головой.

Результат:
Результатом работы лиспа является объект MTEXT, содержащий в себе искомое поле. После двойного щелчка по этому тексту можно скопировать и вставить поле в нужное место. Можно было бы и сразу занести его в буфер обмена, но я пока не знаю, как. Да и вообще, код еще очень далек от совершенства, это пока, так скажем, бета-версия.

Перспективы развития:
- добавить обработку ошибок;
- добавить возможность копирования поля сразу в буфер обмена;
- добавить возможность вставки поля сразу в другую ячейку (другой) таблицы, либо в существующий текст или атрибут, в зависимости от того, куда ткнет мышью пользователь;
- повесить на курсор фантом - "висящий" на курсоре объект для вставки (это, похоже, взаимоисключает предыдущий пункт);
- создать реактор на событие - редактирование ячейки, который запустит процедуру UpdateTextCellFields
- ........

Используемые в коде функции и их авторы:

Используемые в академическом плане:
insfld Кулик Алексей aka kpblc
get_cell_value VVA
и некоторые другие из ссылок в начале сообщения.

Библиотечные:
_dwgru-dwgprops-get-all-prop VVA
_dwgru-dwgprops-get-custom-prop VVA
_dwgru-dwgprops-set-custom-prop VVA
_dwgru-assoc-multi VVA
_dwgru-assoc VVA
_dwgru-string-some-part ShaggyDoc
_dwgru-str->list Елпанов Евгений
dwgru-string-to-list ShaggyDoc
dwgru-string-right-part ShaggyDoc
dwgru-string-left-part ShaggyDoc
LM:UnFormat Lee Mac
Number2Alpha Gilles Chanteau
Alpha2Number Gilles Chanteau

Выражаю свои глубочайшие признательность и благодарность Авторам. Если ошибся в авторстве, прошу простить и поправить.
Все необходимые функции включены в листинг.
______________________________________________
Обновление 07/08/2013
Теперь поле вставляется туда, куда укажет пользователь: это может быть ячейка таблицы, текст, мтекст, мультивыноска. Если пользователь укажет на пустое место или на ту часть чертежа, где нет текстовых объектов, то создастся новый мтекст с полем.

Код:

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

 ;;--------------------------------------------------------
;;Команда cоздает поле (field), ссылающееся на текстовое значение ячейки таблицы.
;; Работает в связке с командой UpdateTextCellFields (см.ниже) 
;; Подробности на http://forum.dwg.ru/showthread.php?p=1130077#post1130077
;; Описание используемых функций
;; get_cell_by_pick
;; get_cell_value
;; _dwgru-dwgprops-get-all-prop
;; _dwgru-dwgprops-get-custom-prop
;; _dwgru-dwgprops-set-custom-prop
;; _dwgru-assoc-multi
;; _dwgru-assoc
;; _dwgru-string-some-part
;; _dwgru-str->list
;; dwgru-string-to-list
;; dwgru-string-right-part
;; dwgru-string-left-part
;; LM:UnFormat
;; Number2Alpha
;; Alpha2Number
(defun C:TCF nil (C:TextCellField))
(defun C:TextCellField ( / *error* adoc oldOSMODE pt pt2 str TextHeight ColumnWidth txtobj tblobj tblset lst row col TargetObj)
(vl-load-com)
	(defun *error* (msg)
		(if oldOSMODE (setvar "OSMODE" oldOSMODE))
		(vla-EndUndomark adoc)
		(princ)
	) ;defun *error*
	(vla-StartUndomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
	(setq oldOSMODE (getvar "OSMODE"))
	(while (null row)
		(setvar "OSMODE" 0)
		(if (null pt)(setq pt (getpoint "\nВыберите ячейку таблицы <Отмена>:")))
		(setvar "OSMODE" oldOSMODE)
		(if (null pt) (progn (princ "\nОтменено пользователем") (exit)))
		(if (get_cell_by_pick pt)
			(progn
				(setvar "OSMODE" 0)
				(if (null pt2) (setq pt2 (getpoint "\nУкажите точку, ячейку или текстовый объект для вставки поля <Отмена> : ")))
				(setvar "OSMODE" oldOSMODE)
				(if (null pt2) (progn (princ "\nОтменено пользователем") (exit)))
				(_dwgru-dwgprops-set-custom-prop 
					(strcat "Table" 
							(vla-get-Handle tblobj)
							"_" 
							(vl-princ-to-string (Number2Alpha (1+ col)))
							(vl-princ-to-string (1+ row))
					) ;_ end of strcat
					(LM:UnFormat (vla-GetText tblobj row col) nil)
					nil
				);_ end of (_dwgru-dwgprops-set-custom-prop)
				(setq str
					(strcat "%<\\AcVar CustomDP.Table" 
							(vl-princ-to-string (vla-get-Handle tblobj))
							"_"
							(vl-princ-to-string (Number2Alpha (1+ col)))
							(vl-princ-to-string (1+ row))
							">%"
					) ;_ end of strcat
				) ;_ end of setq str
				(setq TextHeight (vla-GetCellTextHeight tblobj row col))
				(setq ColumnWidth (vla-GetColumnWidth tblobj col))
				(cond
					(	(get_cell_by_pick pt2) ;_cond #1
						(if (eq (vla-IsContentEditable tblobj row col) :vlax-true)
							(progn
								(vla-SetText tblobj row col str)
								(vla-SetCellTextHeight tblobj row col TextHeight)
							) ;_ end of progn
							(progn
								(princ "\nСодержимое ячейки заблокировано")
							) ;_ end of progn
						) ;_ end of if
					) ;_end of cond #1
					(	(null (ssget "_C" (polar pt2 (/ pi 4) 3) (polar pt2 (/ (* 5 pi) 4) 3) '((0 . "*TEXT,ATTRIB,ATTDEF,MULTILEADER")))) ;_cond #2
						(progn
							(setq txtobj
								(vla-addMtext
									(vla-get-ModelSpace adoc) 
									(vlax-3d-point (trans pt2 1 0))
									ColumnWidth
									str
								) ;_ end of vla-addtext
							) ;_ end of setq txtobj
							(vla-put-Height txtobj TextHeight)
						) ;_ end of progn
					) ;_end of cond #2
					(	(setq ss (ssget "_C" (polar pt2 (/ pi 4) 3) (polar pt2 (/ (* 5 pi) 4) 3) '((0 . "TEXT")))) ;_cond #3
						(progn
							(setq TargetObj (vlax-ename->vla-object (ssname ss 0)))
							(vla-put-TextString TargetObj str)
						) ;_ end of progn
					) ;_end of cond #3
					(	(setq ss (ssget "_C" (polar pt2 (/ pi 4) 3) (polar pt2 (/ (* 5 pi) 4) 3) '((0 . "MTEXT")))) ;_cond #4
						(progn
							(setq TargetObj (vlax-ename->vla-object (ssname ss 0)))
							(vla-put-TextString TargetObj "-")
							(vla-put-TextString TargetObj str)
						) ;_ end of progn
					) ;_end of cond #4
					(	(setq ss (ssget "_C" (polar pt2 (/ pi 4) 3) (polar pt2 (/ (* 5 pi) 4) 3) '((0 . "MULTILEADER")))) ;_cond #5
						(progn
							(setq TargetObj (vlax-ename->vla-object (ssname ss 0)))
							(vla-put-TextString TargetObj (strcat "\\pxse0.76;" str))
							(command "_.UPDATEFIELD" ss "")
							(setq jstf (vla-get-TextJustify TargetObj))
							(vla-put-TextJustify TargetObj 1)
							(vla-put-TextJustify TargetObj jstf)
						) ;_ end of progn
					) ;_end of cond #5
				) ;_ end of cond
			) ;_ end of progn
			(progn
				(setvar "OSMODE" 0)
				(setq pt (getpoint "\nЭто не таблица!\nВыберите ячейку таблицы <Отмена>:"))
				(setvar "OSMODE" oldOSMODE)
				(setq row nil)
				(if (null pt) (progn (princ "\nОтменено пользователем") (exit)))
			) ;_ end of progn
		) ;_ end of if
	) ;_ end of while
	(vla-EndUndomark adoc)
	(princ)
) ;_ end of defun C:TextCellField


;;--------------------------------------------------------
;; Команда обновляет свойства чертежа (dwgprops) и поля, созданные 
;; командой TextCellField (см. выше) в соответствии с содержимым ячейки таблицы
(defun C:UTCF nil (C:UpdateTextCellFields))
(defun C:UpdateTextCellFields ( / adoc DWGPROP n tblobj ExcellColumn row col)
	(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	(setq DWGPROP (_dwgru-dwgprops-get-all-prop nil))
	(setq n 0)
	(foreach item DWGPROP
		(cond 
			(	(wcmatch (car item) "Table*")
				(progn
					(setq tblobj (vlax-ename->vla-object (handent (substr (dwgru-string-left-part (car item) "_") 6))))
					(setq ExcellColumn (dwgru-string-right-part (car item) "_"))
					(setq row (cadr (_dwgru-str->list ExcellColumn)))
					(setq col (Alpha2Number (car (_dwgru-str->list ExcellColumn))))
					(if (and tblobj (>= (vla-get-columns tblobj) col) (>= (vla-get-rows tblobj) row))
						(progn
							(_dwgru-dwgprops-set-custom-prop 
								(car item) 
								(get_cell_value tblobj ExcellColumn)
								nil_
							)
						) ;_ end of progn
						(progn
							(vla-RemoveCustomByKey (vla-Get-SummaryInfo adoc) (car item))
							(setq n (1+ n))
						) ;_ end of progn
					) ;_ end of if
				) ;_ end of progn
			)
		) ;_ end of cond
	) ;_ end of foreach
	(if (> n 0) (alert (strcat "Количество удаленных ячеек, на которые ссылались поля: " (vl-princ-to-string n))))
	(vla-regen adoc AcAllViewports)
	(princ)
) ;_ end of defun C:UpdateTextCellFields


;;--------------------------------------------------------
;; Функция получает ячейку таблицы по указанной точке
;; Если точка внутри таблицы, возвращает список вида (<vla-объект таблицы> <номер строки> <номер столбца>)
;; если вне таблицы - возвращает nil
(defun get_cell_by_pick (pt / )
				(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
				(if (and tblobj row col) (list tblobj row col) nil)
) ;_ end of defun (get_cell_by_pick)


;;--------------------------------------------------------
;; Функция получает строку - значение ячейки таблицы
(defun get_cell_value (tblobj ExcellColumn /)
;;; tblobj - vla-object 
;;; ExcellColumn - string - "A1" B2"
;;; Use
;;; (get_cell_value (vlax-ename->vla-object(car(entsel))) "A2")
	(apply
		'(lambda (col row)
			(LM:UnFormat (vla-GetText tblobj (1- row) (1-(Alpha2Number  col))) nil)
		)
		(_dwgru-str->list (strcase ExcellColumn))
	)
) ;_ end of defun get_cell_value


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * _dwgru-dwgprops-get-all-prop
;;; *
;;; * 23/07/2008 Версия 0002. Makswell
;;; * 27/12/2007 Версия 0001.  Владимир Азарко   (VVA)
;;; ************************************************************************
(defun _dwgru-dwgprops-get-all-prop (Doc / si ret nc key value)
;;; Возвращает свойства файла, установленные командой _dwgprops
;;; Возвращается ассоциативный список, где ключом служит:
;;;      - для свойств, созданных пользователем (закладка ПРОЧИЕ)
;;;          ИМЯ СВОЙСТВА
;;;     - для стандартных свойств (закладка ДОКУМЕНТ)
;;;             Поле                  Ключ  
;;;             НАЗВАНИЕ           - *TITLE*
;;;             АВТОР              - *AUTHOR*
;;;             ТЕМА               - *SUBJECT*
;;;             КЛЮЧЕВЫЕ СЛОВА     - *KEYWORDS*
;;;             ЗАМЕТКИ            - *COMMENTS*
;;;             БАЗА ГИПЕРССЫЛКИ   - *HYPERLINK*
;;; Doc - указатель на обрабатываемый документ, nil - текущий

  ;|
;;; Пример
(_dwgru-dwgprops-get-all-prop nil) ;;;(("*AUTHOR*" "VVA") ("*COMMENTS*" "Заметка") ("*HYPERLINK*" "База")
                               ;;;("*KEYWORDS*" "Ключ") ("*TITLE*" "Назван") ("*SUBJECT*" "Тема") ("UNIQKEY" "Key"))
|;
  (and
    (or	Doc
	(setq Doc (vla-get-activeDocument (vlax-get-acad-object)))
    )
    (setq si (vla-get-SummaryInfo Doc))
    (setq ret (list
		(list "*AUTHOR*" (vla-get-author si))
		(list "*COMMENTS*" (vla-get-comments si))
		(list "*HYPERLINK*" (vla-get-HyperlinkBase si))
		(list "*KEYWORDS*" (vla-get-keywords si))
		(list "*TITLE*" (vla-get-Title si))
		(list "*SUBJECT*" (vla-get-Subject si))
	      )
    )
    (setq nc (vla-numcustominfo si))
    (while (> nc 0)
      (vla-GetCustomByIndex si (- nc 1) 'key 'value)
      (setq ret (append ret (list (list key value))))
      (setq nc (1- nc))
    )
    (vlax-release-object si)
  )
  ret
) ;_end of defun (_dwgru-dwgprops-get-all-prop)


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * _dwgru-dwgprops-get-custom-prop
;;; *
;;; * 27/12/2007 Версия 0001.  Владимир Азарко   (VVA)
;;; ************************************************************************
(defun _dwgru-dwgprops-get-custom-prop (key Doc / app counter counter2 counter3 doc dwgprops k v)
;;; Возвращает значение свойства, созданного пользователем (команда _dwgprops)
;;; Возвращается ассоциативный список, где ключом служит:
;;;      - для свойств, созданных пользователем (закладка ПРОЧИЕ)
;;;    key - строка ИМЯ СВОЙСТВА (закладка ПРОЧИЕ)
;;;        - для стандартных свойств (закладка ДОКУМЕНТ)
;;;              Поле                  Ключ  
;;;             НАЗВАНИЕ           - *TITLE*
;;;             АВТОР              - *AUTHOR*
;;;             ТЕМА               - *SUBJECT*
;;;             КЛЮЧЕВЫЕ СЛОВА     - *KEYWORDS*
;;;             ЗАМЕТКИ            - *COMMENTS*
;;;             БАЗА ГИПЕРССЫЛКИ   - *HYPERLINK*
;;;
;;; Использует функцию библиотеки
;;;                 _dwgru-dwgprops-get-all-prop
;;;                 _dwgru-assoc  (_dwgru-assoc-multi)
 
;;; Doc - указатель на обрабатываемый документ, nil - текущий
 
 (cadr(_dwgru-assoc key (_dwgru-dwgprops-get-all-prop Doc)))
) ;_end of defun (_dwgru-dwgprops-get-custom-prop)


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * _dwgru-dwgprops-set-custom-prop
;;; *
;;; * 23/07/2008 Версия 0002. Makswell
;;; * 27/12/2007 Версия 0001.  Владимир Азарко   (VVA)
;;; ************************************************************************
(defun _dwgru-dwgprops-set-custom-prop (key value Doc / si)
;;;Создает в свойствах рисунка (команда _dwgprops закладка ПРОЧИЕ)
;;; Свойство с ключом key и значение value
;;; Если свойства не было, оно создается, иначе изменяется
;;;    key - строка ИМЯ СВОЙСТВА (закладка ПРОЧИЕ)
;;;    value - строка (string) - значение свойства  
;;; Использует функцию библиотеки
;;;                 _dwgru-dwgprops-get-custom-prop
;;; Doc - указатель на обрабатываемый документ, nil - текущий
;;; Возвращает - nil
  ;|
;;;Пример
(_dwgru-dwgprops-set-custom-prop "dwgru" "dwgru-dwgprops-set-custom-prop" nil)
|;
  (or Doc
      (setq Doc (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
  )
  (setq si (vla-Get-SummaryInfo Doc))
  (if (_dwgru-dwgprops-get-custom-prop key Doc)
    (progn
      (setq key (car (_dwgru-assoc key (_dwgru-dwgprops-get-all-prop Doc))))
      (vla-SetCustomByKey si key value)
    )
    (vla-AddCustomInfo si key value)
  )
) ;_end of defun (_dwgru-dwgprops-set-custom-prop)


(defun _dwgru-assoc-multi (key lst)
  (if (= (type key) 'str)
    (setq key (strcase key))
    ) ;_ end of if
  (vl-remove-if-not
    (function
      (lambda (a / b)
        (and (setq b (car a))
             (or (and (= (type b) 'str) (= (strcase b) key)) (equal b key))
             ) ;_ end of and
        ) ;_ end of lambda
      ) ;_ end of function
    lst
    ) ;_ end of vl-remove-if-not
) ;_ end of defun (_dwgru-assoc-multi)
(defun _dwgru-assoc (key lst)
  (car (_dwgru-assoc-multi key lst))
) ;_ end of defun (_dwgru-assoc)


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * _dwgru-string-some-part
;;; *
;;; * 03/12/2007 Версия 0001.  Сергей Зуев   (ShaggyDoc)
;;; ************************************************************************
(defun _dwgru-string-some-part
                              (string delim_char is_left_part / lst)
    ;;;  возврат левой (если is_left_part)или правой части
    ;;;  строки string с разделителем  delim_char
    ;;; Использует функцию библиотеки
    ;;;                 dwgru-string-to-list

    ;;; Параметры: 
    ;;; string     - исходная строка
    ;;; delim_char  - разделитель (string)
    ;;; is_left_part  - T или NIL. Если истина (T), то слева. Иначе справа. (boolean)
    ;;; Возврат:
    ;;;   строку (String)
  
    ;;; Пример:
  ;|
(_dwgru-string-some-part " M1:=100" "=" T) ;_Результат   " M1:"
(_dwgru-string-some-part " M1:=100" "=" NIL)  ;_Результат  "100"
(_dwgru-string-some-part " M= M1:=100" "=" T) ;_ Результат  " M"
(_dwgru-string-some-part " M= M1:=100" "=" NIL) ;_ Результат  "100"
(_dwgru-string-some-part "просто строка" "=" T)  ;_ Результат  "просто строка"
(_dwgru-string-some-part "просто строка" "=" NIL) ;_Результат   ""
|;
	(if (> (length	(setq lst
						(dwgru-string-to-list string delim_char)
					) ;_ end of setq
			) ;_ end of length
			1
		) ;_ end of >
		;; если список, иначе была просто строка
		(if is_left_part (car lst) (last lst))
		(if is_left_part string "")
	) ;_ end of  if
) ;_ end of defun (_dwgru-string-some-part)


;;--------------------------------------------------------
;; Функция разделяет строку на список текстовых и цифровых составляющих.
;; Запятая между цифрами, зменяется на точечный разделитель дробной части.
(defun _dwgru-str->list (s)
                 ;|
***************************************************************************************
*
* Программа разделяет строку на список текстовых и цифровых составляющих.
* Запятая между цифрами, зменяется на точечный разделитель дробной части.
* 
**************************************************************************************
*
* Написал Елпанов Евгений       (ElpanovEvgeniy)
*
* дата создания (13/10/2007 a 11:42)
* написано во время конкурса на форуме:
* http://www.cadxp.com/XForum+viewthread-fid-101-tid-16943-page-2.html
***************************************************************************************
* Пример использования и результатов работы:
* (_dwgru-str->list "point.25.4cm.")           => ("point." 25.4 "cm.")
* (_dwgru-str->list "point.25,4cm.")           => ("point." 25.4 "cm.")
* (_dwgru-str->list "point.3/8cm.")            => ("point." 0.375 "cm.")
* (_dwgru-str->list "qvf12qsdf125 5sf 56dfv2") => ("qvf" 12 "qsdf" 125 " " 5 "sf " 56 "dfv" 2)
***************************************************************************************
 |;
 (defun str->list1 (a b f)
  (cond
   ((null b)
    (list (if f
           (cond ((vl-position 46 a) (atof (vl-list->string (reverse a))))
                 ((vl-position 47 a) (distof (vl-list->string (reverse a))))
                 ((vl-position 44 a) (atof (vl-list->string (subst 46 44 (reverse a)))))
                 (t (atoi (vl-list->string (reverse a))))
           ) ;_ cond
           (vl-list->string (reverse a))
          ) ;_ if
    ) ;_ list
   )
   (f
    (if (or (= (car b) 44) (< 45 (car b) 58))
     (str->list1 (cons (car b) a) (cdr b) f)
     (cons (cond ((vl-position 46 a) (atof (vl-list->string (reverse a))))
                 ((vl-position 47 a) (distof (vl-list->string (reverse a))))
                 ((vl-position 44 a) (atof (vl-list->string (subst 46 44 (reverse a)))))
                 (t (atoi (vl-list->string (reverse a))))
           ) ;_ cond
           (str->list1 (list (car b)) (cdr b) nil)
     ) ;_ cons
    ) ;_ if
   )
   (t
    (if (< 47 (car b) 58)
     (cons (vl-list->string (reverse a)) (str->list1 (list (car b)) (cdr b) t))
     (str->list1 (cons (car b) a) (cdr b) nil)
    ) ;_ if
   )
  ) ;_ cond
 ) ;_ defun
 (setq s (vl-string->list s))
 (str->list1 (list (car s))
             (cdr s)
             (if (or (= (car s) 44) (< 45 (car s) 58))
              t
             ) ;_ if
 )
) ;_ end of defun (_dwgru-str->list)


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-string-to-list
;;; *
;;; * 03/12/2007 Версия 0001.  Сергей Зуев   (ShaggyDoc)
;;; ************************************************************************
(defun dwgru-string-to-list (str delimiter / pos)
;;; Возврат списка подстрок строки str с разделителем  delimiter 
;;; Использует функцию библиотеки
    ;;;                 dwgru-string-replace
    ;;; Параметры: 
    ;;; string     - исходная строка
    ;;; delimiter  - разделитель (string)
    ;;; Возврат:
    ;;;   строку (String)
  
    ;;; Пример:
    ;|
(dwgru-string-to-list "М:1=100" "=") ;_Результат ("М:1" "100")
(dwgru-string-to-list "М:1=" "=") ;_Результат  ("М:1" "")
(dwgru-string-to-list "" "=") ;_Результат  ("")
(dwgru-string-to-list "1 2 3   4   5" " ") ;_Результат  ("1" "2" "3" "4" "5")
 (dwgru-string-to-list "Я говорю, он говорит, они говорят" ",")
 ;_Результат ("Я говорю" " он говорит" " они говорят")
 (dwgru-string-to-list "123456789" "=") ;_Результат  ("123456789") 
|;
  ;;; для варианта, когда разделитель пробел надо
;;; заменить в строке все двойные пробелы на одинарные
    (if (= delimiter (chr 32))
        (setq str (dwgru-string-replace str (strcat (chr 32) (chr 32)) delimiter))
    ) ;_ end of if
    (if (setq pos (vl-string-search delimiter str))
        (cons
            (substr str 1 pos)
            (dwgru-string-to-list
                (substr
                    str
                    (+ (strlen delimiter) pos 1)
                ) ;_ end of substr
                delimiter
            ) ;_ end of ru-string-pl-string-to-list
        ) ;_ end of cons
        (cons str '())
    ) ;_ end of if
) ;_ end of defun (dwgru-string-to-list)


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-string-right-part
;;; *
;;; * 03/12/2007 Версия 0001.  Сергей Зуев   (ShaggyDoc)
;;; ************************************************************************
(defun dwgru-string-right-part (string delim_char)
;;; возврат правой половины строки после разделителя
;;; Использует функцию библиотеки
    ;;;                 _dwgru-string-some-part
    ;;; Параметры: 
    ;;; string     - исходная строка
    ;;; delim_char  - разделитель (string)
    ;;; Возврат:
    ;;;   строку (String)
  
    ;;; Пример:
  
;|
(dwgru-string-right-part " M1:=100" "=")   ;_Результат  "100"
(dwgru-string-right-part " M= M1:=100" "=") ;_Результат  "100"
(dwgru-string-right-part "просто строка" "=") ;_Результат   "просто строка"
(dwgru-string-right-part "просто=" "=")  ;_ ""
(dwgru-string-right-part "890" ".")  ;_Результат  ""
(dwgru-string-right-part ".2" ".")  ;_Результат  2
(dwgru-string-right-part "2" ".")  ;_Результат  "" 
(dwgru-string-right-part "2.400" ".") ;_Результат  "400"
|;
    (_dwgru-string-some-part string delim_char NIL)
) ;_ end of defun (dwgru-string-right-part)


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * dwgru-string-left-part
;;; *
;;; * 03/12/2007 Версия 0001.  Сергей Зуев   (ShaggyDoc)
;;; ************************************************************************

(defun dwgru-string-left-part (string delim_char)
;;; возврат левой половины строки до разделителя delim_char
;;; Использует функцию библиотеки
    ;;;                 _dwgru-string-some-part

    ;;; Параметры: 
    ;;; string     - исходная строка
    ;;; delim_char  - разделитель (string)
    ;;; Возврат:
    ;;;   строку (String)
  
    ;;; Пример:
;|  
(dwgru-string-left-part " M1:=100" "=")  ;_Результат  " М1:"
(dwgru-string-left-part " M= M1:=100" "=")  ;_Результат  " М"
(dwgru-string-left-part "просто строка" "=") ;_Результат   "просто строка"
(dwgru-string-left-part "просто=" "=")  ;_Результат  "просто"
|;
(_dwgru-string-some-part string delim_char T)
) ;_ end of defun (dwgru-string-left-part)


;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;

(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
) ;_end of defun (LM:UnFormat)


(defun Number2Alpha (Num# / Val#)
;-------------------------------------------------------------------------------
; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"
;-------------------------------------------------------------------------------
	(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
);defun Number2Alpha


(defun Alpha2Number (Str$ / Num#)
;-------------------------------------------------------------------------------
; Alpha2Number - Converts Alpha string into Number
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Str$ = String to convert
; Syntax example: (Alpha2Number "ABC") = 731
;-------------------------------------------------------------------------------
  (if (= 0 (setq Num# (strlen Str$)))
    0
    (+ (* (- (ascii (strcase (substr Str$ 1 1))) 64) (expt 26 (1- Num#)))
       (Alpha2Number (substr Str$ 2))
    );+
  );if
);defun Alpha2Number
(princ)

d.mOnII · Регистрация: 22.01.2013

добрый день.
При вставке текстового поля данным лиспом из таблицы возникает слдующая проблема:
1. при вставке в файл внешней ссылки, в которой присутствует данное поле, в конечном файле это поле не отражается, точнее отражается как ###
2. пробовал решить проблему промежуточным элементом с текстовым полем, в итоге пи вставке внешней ссылки в конечном файле видно следующее:
текстовое поле первое отражается как ###, второе текстовое поле со ссылкой на первое отражается корректно в автокаде, но при печати в ПДФ - снова ###
скрины во вложениях.

Avodo · 08.05.2017, 14:58

Выражаясь простым языком (профи поправят) поля созданные этим лиспом берут информацию из текущего файла, не совсем как хотелось бы по логике, но вот так. Продумайте другой алгоритм работы, возможно сделать таблицу в Экселе и во все файлы загрузить ее через диспетчер связей. Далее следите чтоб все поля TCF напрямую ссылались на таблицу...
Скорее всего вы закидываете все файлы в один как внешние ссылки для автоматической печати? думаю можно придумать вариант с печатью другим способом, например попробуйте Диспетчер подшивок.

d.mOnII · 10.05.2017, 12:27

Цитата:

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

Продумайте другой алгоритм работы, возможно сделать таблицу в Экселе и во все файлы загрузить ее через диспетчер связей. Далее следите чтоб все поля TCF напрямую ссылались на таблицу...
Скорее всего вы закидываете все файлы в один как внешние ссылки для автоматической печати? думаю можно придумать вариант с печатью другим способом, например попробуйте Диспетчер подшивок.

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

поэкспериментировал с атрибутами, но один фиг - только символы ###

Okl · 19.03.2018, 14:30

Спасибо эту программу!!))) Очень полезное решение!))) Все установилось и работало на отлично... но после того как я закрыл Автокад и заново открыл, поля перестали работать((( в чем проблемма? подскажите пожалуйста...

skkkk · 20.03.2018, 02:45

Может, надо загрузить код а автокад? Добавить в автозагрузку? Поиск по словам "как использовать лисп".

Кулик Алексей aka kpblc · 20.03.2018, 07:54

Что значит "поля перестали работать", интересно? А если вручную создать поле - оно тоже перестает работать?

zRaFiNaDz · 24.04.2018, 17:54

Отличнейший lisp, очень помог при автоматизации в проектах - сейчас очень много проектов КЖ к примеру, где меняются отметки, геология, длина свай, название объекта, шифр. Проект для меня с использованием этого лиспа - заполнить табличку в Екселе (10 минут), поправить геологический разрез (10 минут) и все "ЭКСПОРТПДФ". Огромное спасибище авторам!!!!

zRaFiNaDz · 22.05.2018, 06:49

Доброго времени суток всем.
Уже сделал порядка 50-60 проектов используя этот лисп. Но тут столкнулся с проблемой - в файле-доноре (образце) все работало как часы. Взяв этот файл за основу - сменил в екселе текст в ячейках, все обновилось. Но после какого-то момента - начались проблемы. при вводе команды UTCF - автокад выдает ошибку: "Команда: UTCF; ошибка: неверный тип аргумента: lentityp nil", и часть полей в тексте и таблицах обновляется, а часть нет. С чем связана ошибка ума не приложу, проверка и очистка чертежа не помогают. К сожалению проект выложить не могу (конфиденциальность - поля не меняются, так бы ересь какую-нибудь бы вбил и выложил), если кто готов помочь - скину в личку. Заранее спасибо!

skkkk · 24.05.2018, 09:30

Скиньте мне файл на почту через мой профиль. В личке файлы не прикладываются.

----- добавлено через ~6 ч. -----
zRaFiNaDz, перезалил файл в первом посте. Ошибку вызывал тот факт, что несколько таблиц, на которые ссылались поля, были удалены из чертежа. Не найдя их, программа удивлялась и отваливалась. Ошибку устранил, заодно добавил чистку ненужных свойств чертежа. При первом запуске UTCF в приложенном файле в комстроке будет выведен отчет о том, скольких и каких таблиц не хватает (указана малоинформативная для пользователя метка объекта-таблицы в базе данных чертежа)

OKJI · 06.11.2018, 11:01

Цитата:

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

Доброго времени суток всем.
Уже сделал порядка 50-60 проектов используя этот лисп. Но тут столкнулся с проблемой - в файле-доноре (образце) все работало как часы. Взяв этот файл за основу - сменил в екселе текст в ячейках, все обновилось. Но после какого-то момента - начались проблемы. при вводе команды UTCF - автокад выдает ошибку: "Команда: UTCF; ошибка: неверный тип аргумента: lentityp nil", и часть полей в тексте и таблицах обновляется, а часть нет. С чем связана ошибка ума не приложу, проверка и очистка чертежа не помогают. К сожалению проект выложить не могу (конфиденциальность - поля не меняются, так бы ересь какую-нибудь бы вбил и выложил), если кто готов помочь - скину в личку. Заранее спасибо!

У этой программы ограниченное количество полей... каждый год имеет свой рандомный номер... есть хоть и бесконечно малая но вероятность того что рандомный код совпадет с предыдушим...

skkkk · 06.11.2018, 12:07

Он имеет не рандомный номер, а строку, состоящую из хэндла таблицы и номера ячейки. В пределах одного чертежа не может быть таблиц с одинаковым хэндлом.

OKJI · 06.11.2018, 12:57

Цитата:

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

Он имеет не рандомный номер, а строку, состоящую из хэндла таблицы и номера ячейки. В пределах одного чертежа не может быть таблиц с одинаковым хэндлом.

Разве такого рода шифрование не может дать одинаковую последовательность символов для разных чисел?

----- добавлено через 44 сек. -----
зачем вообще эта шифровка идет?

skkkk · 09.11.2018, 13:38

Это не шифровка. Я использовал эту функцию, найденную в Сети лишь для того, чтобы преобразовывать номер столбца из цифры в букву и обратно.

Код:

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

Команда: (Number2Alpha 1)
"A"
Команда: (Number2Alpha 2)
"B"
Команда: (Number2Alpha 3)
"C"
Команда: (Number2Alpha 26)
"Z"
Команда: (Number2Alpha 27)
"AA"

aspel · 19.02.2019, 01:45

skkkk, а может есть возможность добавить ввод имени (а не авоматическое присвоение имения в виде Table<handle таблицы>_<адрес ячейки>)в свойствах чертежа (команда _dwgprops), во вкладке Прочее (Custom) псоле выборя ячейки из таблицы

Barmaley Bubusikin · 22.02.2019, 00:43

skkkk, хочется чтобы неразрывный пробел оставался невидимым, а не превращался в \~.

Куинбус Флестрин · 20.09.2019, 23:23

Уважаемый skkkk, простите за дилетантский вопрос: Возможно ли написать макрос для работы с Вашей командой TCF, чтобы он бесконечно повторялся (с префиксом *) и с из команды выходом по Esc.

skkkk · 23.09.2019, 13:10

Куинбус Флестрин, надо добавить в код (в самое начало) вот эту строку:

Код:

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

(defun C:CTCF ( / ) (while T (C:TextCellField)))

Вызывать соответственно CTCF или (C:CTCF).
Проверил на 2011.

Barmaley Bubusikin · 15.10.2019, 23:09

Уважаемый автор, если в ячейке таблицы есть неразрывный пробел, то в поле, которое ссылается на эту ячейку, он отображается как \~. Это лечится?

skkkk · 16.10.2019, 20:44

Barmaley Bubusikin, это вряд ли. Такая штука заложена в самом Автокаде. Если сделать поле со ссылкой на содержимое текста, например, то будет то же самое.

mr.frai1992 · 02.03.2020, 16:47

skkkk, присоединяюсь к вышеперечисленным благодарностям! Очень хорошая и нужная программа получилась!
Р.S. Может я невнимательно прочитал что-то или не так делаю... С атрибутами блоков пока не получилось?

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива	Profan	Готовые программы	272	06.06.2021 23:12
Какой язык перспективен для инженера-конструктора с условием	The_Mercy_Seat	Программирование	705	17.03.2021 14:19
Считывание значение ячейки таблицы в виде Field в AutoLISP	tokhot	LISP	9	08.01.2017 17:54
Может ли поле принимать текстовое значение ячейки таблицы?	Sergiy	AutoCAD	23	01.08.2013 12:30

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