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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Создание поля (field), ссылающегося на текстовое значение ячейки таблицы.

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

Ответ
Поиск в этой теме
Непрочитано 01.08.2013, 12:14 6 |
LISP. Создание поля (field), ссылающегося на текстовое значение ячейки таблицы.
skkkk
 
Регистрация: 20.03.2008
Сообщений: 2,653

По многочисленным просьбам трудящихся форумчан и не только их. Возник этот вопрос довольно давно.
Может ли поле принимать текстовое значение ячейки таблицы?
Возможно ли выцепить текст у таблиц? Как это можно реализовать на 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)

Вложения
Тип файла: lsp TextCellField.lsp (25.6 Кб, 1242 просмотров)


Последний раз редактировалось skkkk, 24.05.2018 в 15:21. Причина: Обновление
Просмотров: 125833
 
Автор темы   Непрочитано 21.01.2016, 14:28
#81
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


perpetule, с точки зрения универсальной видимости - да, но ведь этот цвет будет выводиться на печать. Думаю, за такое юзеры спасибо не скажут. Тут, я так понимаю, смысл в том, чтобы при пустой ячейке поле, ссылающееся на нее, оставалось пустым до того, как в ячейке не появится текстовое значение. А раз черточки поля (----) при ссылке на пустую ячейку не устраивают, то, предположительно, и фон тут будет лишним на бумаге.
skkkk вне форума  
 
Непрочитано 21.01.2016, 16:49
#82
hardbringer


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


Цитата:
Сообщение от skkkk Посмотреть сообщение
Боюсь, подсказать тут не получится, поскольку там вопрос не простой замены пары символов в коде, но внедрить эту возможность в ближайшее время также постараюсь. Вот только добавлять ли программно такому тексту белый фон? Убирать его в случае нужды после придется вручную. Или оставить без фона, и тогда одиночный мтекст, содержащий такое поле нельзя будет выбрать мышкой?
А возможно ли сделать следующим образом: скажем, при отсутствии данных в исходной ячейке автоматически поменять цвет выводимого текста на белый, но при обновлении связи организовать проверку, которая бы меняла цвет на черный при появлении в ячейке значения непустого значения. То есть проверять все значения на "непустоту" и корректировать цвет текста?
Если так получится сделать, это будет просто шикарно.
hardbringer вне форума  
 
Непрочитано 22.01.2016, 10:33
#83
perpetule


 
Регистрация: 23.09.2008
Волгоград
Сообщений: 810
<phrase 1= Отправить сообщение для perpetule с помощью Skype™


Цитата:
perpetule, с точки зрения универсальной видимости - да, но ведь этот цвет будет выводиться на печать
Вся множительная техника за разумные деньги Ч/Б, что фактически означает запрет использовать цвет для условных обозначений.
P.S. Все сказанное ИМХО, холивар по этому поводу излишен.
Холивар или холивор (от англ. holy war, «священная война»)
__________________
tc71
perpetule вне форума  
 
Непрочитано 18.04.2016, 11:19
#84
quazi


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


Очень годный лисп.
Кому не нравятся черточки, то проще пробелы вводить в исходную таблицу.
Посоветуйте способ как весь этот огород (исходная таблица, польз. поля и наконец мои блоки в атрибутах котрых ссылки на эти поля) скопировать в другой файл с сохранением связей.
При копировании только элементов чертежа поля не перенесутся и поменяется handle таблицы. У меня одна большая таблица, всего полей 200 получится.
Что можно придумать?
quazi вне форума  
 
Непрочитано 18.04.2016, 11:22
#85
RNB

Проектирование мостов
 
Регистрация: 29.01.2014
Новосибирск
Сообщений: 433


Сохранить как...
RNB вне форума  
 
Непрочитано 18.04.2016, 16:15
#86
quazi


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


RNB, мда...
Может подскажет кто-то как сделать поиск с заменой по всем field expression в чертеже?
Где то тут советовали использовать редактор из vetcad, но у меня не сработало.

И еще: как победить знаки вопроса вместо символов куба, квадрата? (00B2, 00B3)

Последний раз редактировалось quazi, 18.04.2016 в 17:17.
quazi вне форума  
 
Непрочитано 18.04.2016, 19:03
#87
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от quazi Посмотреть сообщение
как победить знаки вопроса вместо символов куба, квадрата? (00B2, 00B3)
В текстовом стиле поменять шрифт на "понимающий" символы куба и квадрата
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.04.2016, 19:23
#88
quazi


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


VVA, эти символы есть в шрифте, теряются они при переносе содержимого ячейки таблицы в пользовательское свойство чертежа, уже в свойстве получаются вопросы.
Если руками создать свойство и вписать в него любой символ, то поле ссылающееся на это свойство будет нормально отображать весь юникод, как минимум эти символы.
quazi вне форума  
 
Непрочитано 18.04.2016, 20:52
#89
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Я поражаюсь... Тема вроде вообще не о пользовательских свойствах чертежа.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 28.10.2016, 10:50
#90
pobat

инжинириг
 
Регистрация: 26.01.2012
Сообщений: 20


А чисто технически можно ли ссылаться не на таблицу а другой mtext ?
pobat вне форума  
 
Непрочитано 28.10.2016, 12:29
#91
allrather


 
Регистрация: 27.02.2011
Минск
Сообщений: 169
Отправить сообщение для allrather с помощью Skype™


Цитата:
Сообщение от pobat Посмотреть сообщение
А чисто технически можно ли ссылаться не на таблицу а другой mtext ?
Это возможно даже чисто AutoCADически!
Нажмите на изображение для увеличения
Название: Screen Shot 001.PNG
Просмотров: 152
Размер:	35.1 Кб
ID:	178339
allrather вне форума  
 
Непрочитано 07.11.2016, 15:32
#92
pobat

инжинириг
 
Регистрация: 26.01.2012
Сообщений: 20


Цитата:
Сообщение от allrather Посмотреть сообщение
Это возможно даже чисто AutoCADически!
Вложение 178339
спасибо за ответ!
Я имел ввиду в один клик,
выделить любой текст, а далее при кликании любого другого текста вставлялось поле (ссылка) на первый выеденный
pobat вне форума  
 
Автор темы   Непрочитано 07.11.2016, 18:47
#93
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


pobat, у Lee Mac'а есть такая программа - Quick Field (ссылка вверху страницы на lsp-файл).

Цитата:
Сообщение от pobat Посмотреть сообщение
выделить любой текст, а далее при кликании любого другого текста вставлялось поле (ссылка) на первый выеденный
Загружаем в кад лисп Quick Field, а затем еще и этот кусочек кода (можно добавить в конец Quick Field):
Код:
[Выделить все]
(defun c:test ( ) (LM:QuickField "TextString" "" 1))
skkkk вне форума  
 
Непрочитано 29.11.2016, 12:22
#94
greyser


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


приветствую!
а как эту прогу (как функцию или подпрограмму) использовать для копирования значения определенных содержимого ячеек строки одной таблицы и вставки в определенное поле ячейки другой таблицы. для лучшего понимания прикладываю dwg.
Алгоритм такой: из таблицы извлечения данных смотрим на ячейку 1 столбца строки N и по значению этой ячейки выбираем поля в таблице спецификации, куда копировать содержимое ячеек строки. Прогоняем все строки и увеличиваем кол-во в спецификации по мере продвижения вниз по таблице извлечения данных. Надеюсь, понятно пояснил.
Вложения
Тип файла: dwg
DWG 2010
пример.dwg (630.8 Кб, 39 просмотров)
greyser вне форума  
 
Автор темы   Непрочитано 29.11.2016, 14:00
#95
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


greyser, боюсь, что воплощение подобного алгоритма потребует в разы (если не в десятки раз) больше кода, чем сама эта прога (TCF).
Во-первых, TCF не приспособлена для вставки поля в часть ячейки таблицы - она заменит полностью содержимое ячейки. Думаю, тут лучше писать все с нуля, возможно, используя некоторые куски кода из TCF, если там действительно будет необходимость ссылаться на текстовые ячейки таблицы.
Во-вторых, алгоритм нужно прорабатывать куда более серьезно, чем поместить его в три строки текста, как в #94. И делать это должен, скорее всего, сам программист, который сможет взяться за это. При этом он должен основательно вникнуть в рабочий процесс, и скорее всего научить пользователей делать работу по-новому, так, как это будет необходимо программе - ни шага в сторону. По опыту могу сказать, что если это и реально, то стоить будет очень недешево.
skkkk вне форума  
 
Непрочитано 29.11.2016, 14:34
#96
greyser


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


Цитата:
Сообщение от skkkk Посмотреть сообщение
greyser, боюсь, что воплощение подобного алгоритма потребует в разы (если не в десятки раз) больше кода, чем сама эта прога (TCF).
Во-первых, TCF не приспособлена для вставки поля в часть ячейки таблицы - она заменит полностью содержимое ячейки. Думаю, тут лучше писать все с нуля, возможно, используя некоторые куски кода из TCF, если там действительно будет необходимость ссылаться на текстовые ячейки таблицы.
Во-вторых, алгоритм нужно прорабатывать куда более серьезно, чем поместить его в три строки текста, как в #94. И делать это должен, скорее всего, сам программист, который сможет взяться за это. При этом он должен основательно вникнуть в рабочий процесс, и скорее всего научить пользователей делать работу по-новому, так, как это будет необходимо программе - ни шага в сторону. По опыту могу сказать, что если это и реально, то стоить будет очень недешево.
пользователь я один и это намного облегчает задачу =). с точки зрения дилетанта задача не видится такой драматично сложной, придется самому осваивать программирование. мой вопрос, конечно же, не был просьбой сделать программу, скорее нужен совет, куда бежать. наверняка есть какие-то готовые программы, которые можно скрестить с TCF для решения задачи
greyser вне форума  
 
Автор темы   Непрочитано 29.11.2016, 16:43
#97
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Цитата:
Сообщение от greyser Посмотреть сообщение
наверняка есть какие-то готовые программы, которые можно скрестить с TCF для решения задачи
Это сильно вряд ли. Если только кто-то из подобного рода деятелей не пошел по тому же пути и не изобрел нечто похожее на то, что нужно.
Цитата:
Сообщение от greyser Посмотреть сообщение
скорее нужен совет, куда бежать
Offtop: Думаю, я бы в данном случае не связывался с полями. И с извлечением данных - тоже. Анализировал бы нужным образом схему, составляя по результатам анализа структурированный список,который содержал бы списки строк в количестве, равном числу столбцов. А затем эти строки из списка загонял бы программно в таблицу.
skkkk вне форума  
 
Непрочитано 09.02.2017, 19:36
#98
ackye


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


Всем добрый вечер. Про лисп узнал сегодня, так что пожалуйста не ругайте, если туплю.
У меня есть следующая задача. В эксель таблицу вводятся числовые и текстовые данные. Таблицу я загрузил в модель када, и теперь данные при изменении в эксель меняются в кадовской табличке (после обновления связи). На чертеже у меня есть текстовые поля, которые должны брать текст из таблички. После курения интеренета, я понял что так просто расставлять текст по чертежу из таблички не выйдет и попал в эту тему. Загрузил данный лисп скрипт в кад и при наборе команды textcellfield выходит сообщение нет определения функции: vla-endundomark. У меня есть подозрения, что я что-то делаю не так а может и вовсе пишу не в ту тему. Поясните пожалуйста.
ackye вне форума  
 
Автор темы   Непрочитано 09.02.2017, 23:24
#99
skkkk


 
Регистрация: 20.03.2008
Сообщений: 2,653


Цитата:
Сообщение от ackye Посмотреть сообщение
выходит сообщение нет определения функции: vla-endundomark
Это странно, поскольку (vl-load-com) - функция, подгружающая Visual LISP, в коде присутствует. Похоже на какой-то сбой в системе AutoCAD, слышал о таком, но нечасто.
Какая версия AutoCAD? Нет ли возможности попробовать на других машинах с той же версией?
skkkk вне форума  
 
Непрочитано 10.02.2017, 10:02
#100
ackye


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


skkkk, большое спасибо. На другом компе с той же версией када (2014 на Windows 7) все заработало. А у меня на Win8 не хочет. Попробую поставить другую версию Автокад.
ackye вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Создание поля (field), ссылающегося на текстовое значение ячейки таблицы.

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
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