[Profan]

Оригинал темы находился на форуме autocad.ru. Теперь caduser.ru

Александр Ривилис (2006-02-27 14:12:02)

Код:

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

 
;------------------------------------------------
; Команда: AREATLB
; Эта команда позволяет вставить в заданную
; ячейку таблицы поле (FIELD), соответствуещее
; площади выбранного примитива. Так как это поле
; связано с конкретным примитивом, то при изменении
; примитива поле пересчитывается (необходима
; регенерация)
;------------------------------------------------
(defun C:AREATLB ( / en obj s row col)
(vl-load-com)
(cond
((and (setq en (car (entsel "\nВыберите таблицу: ")))
(= (cdr (assoc 0 (entget en))) "ACAD_TABLE"))
(setq obj (vlax-ename->vla-object en))
(while (setq en (car (entsel "\nВыберите примитив для вставки его площади в таблицу (ENTER — завершение): " )))
(cond
((vlax-property-available-p (vlax-ename->vla-object en) 'Area)
(setq s (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (vla-get-objectid (vlax-ename->vla-object en)))
">%).Area>%"
))
(if (setq p (getpoint "\nУкажите ячейку таблицы: " ))(progn
(if (= :vlax-true (vla-HitTest obj
(vlax-3d-point (trans p 1 0)) (vlax-3d-point (trans (getvar "VIEWDIR") 1 0)) 'row 'col))
(vla-SetText obj row col s)
)
)) ;_endof if progn
)
(t
(princ "\nДля этого примитива невозможно получить свойство Area!")
)
)
)
)
(t
(princ "\nЭто не таблица!")
)
)
(princ)
)

Александр Ривилис (2006-02-27 14:56:06)

P.S.:
1) Если необходимо, чтобы площадь вычислялась с заданными установками UNITS необходимо:
строку ">%).Area>%" заменить на строку ">%).Area \\f \"%lu6%qf1\">%"
2) Если площадь вычисляется в мм^2, а нужно в м^2, то эта строка соответственно заменяется на ">%).Area \\f \"%lu6%qf1%ct8[1e-006]\">%"
3) И т.д.

Владимир Громов (2006-03-25 21:53:47)

Программа хорошо работает. Но мне пришла в голову мысль объединить операции отрисовки контура и вставки значения площади в таблицу. На основе кода Александра Ривилиса получилась такая программа:

Код:

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

 
;------------------------------------------------------------
; Команда: PLAREATAB
; Эта команда позволяет вставить в заданную
; ячейку таблицы поле (FIELD), содержащее значение
; площади построенного контура. Так как это поле
; связано с конкретным объектом, то при изменении
; объекта поле пересчитывается (необходимо обновление
; поля)
; Код можно сохранить в файле plareatab.lsp
; Возможный макрос для кнопки или пункта меню:
; ^C^C(if (not C:PLAREATAB) (load "plareatab")) PLAREATAB
;------------------------------------------------------------
(defun C:PLAREATAB ( / echo en obj s row col)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(vl-load-com)
(vl-cmdf "_.UNDO" "_be")
(cond
((and (setq en (car (entsel "\n Выберите таблицу: ")))
(= (cdr (assoc 0 (entget en))) "ACAD_TABLE"))
(setq obj (vlax-ename->vla-object en))
(setvar "CMDECHO" 1)
(princ "\n Нарисуем контур: ")
(command "_PLINE")
(while (/= (logand (getvar "cmdactive") 31) 0)
(command pause)
)
(setvar "CMDECHO" 0)
(setq en (entlast))
(cond
((vlax-property-available-p (vlax-ename->vla-object en) 'Area)
(setq s (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (vla-get-objectid (vlax-ename->vla-object en)))
">%).Area \\f \"%lu6%qf1%ct8[1e-006]\">%"
))
(if (setq p (getpoint "\n Укажите ячейку таблицы: " ))(progn
(if (= :vlax-true (vla-HitTest obj
(vlax-3d-point (trans p 1 0)) (vlax-3d-point (trans (getvar "VIEWDIR") 1 0)) 'row 'col))
(vla-SetText obj row col s)
)
)) ;_endof if progn
)
) ;cond
)
(t
(princ "\n Это не таблица!")
)
) ;cond
(vl-cmdf "_.UNDO" "_e")
(setvar "CMDECHO" echo)
(princ)
)

Здесь площадь из квадратных миллиметров преобразуется в квадратные метры. Точность вычисления площади определяется заданием количества знаков после точки в диалоговом окне "Единицы" ("Units").
А дальше можно для ячейки последней строки таблицы задать формулу "Сумма" и связать это поле с ячейками, в которые будет вставляться площадь. В результате в этой ячейке будет автоматически подсчитываться сумма площадей контуров. Только в формулу надо будет добавить множитель *0.000001 (для квадратных метров).
Ясно, что все это будет работать только в AutoCAD 2006 и в последующих версиях.

VVA (2007-09-20 16:36:57)
По просьбе отсюда.
http://www.autocad.ru/cgi-bin/f1/boa...38227Nu&page=3
Скрещенные команды Владимира Громова и Александра Ривилиса + если указали ячейку таблицы, то поле с площадью вставится в ячейку, иначе в это место вставится текст в полем. Точность округления и масштабный коэффициент настраиваются через опцию Установки

Код:

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

 
; Команда: PAREATAB
; Эта команда позволяет вставить в указанную точку рисунка или указанную ячейку таблицы
; текст с полем (FIELD), содержащее значение площади построенного или выбранного контура.
; Точность округления и масштабный коэффициент настраиваются через опцию Установки
; Так как это поле связано с конкретным объектом, то при изменении
; объекта поле пересчитывается (необходимо обновление поля)
; Код можно сохранить в файле pareatab.lsp
; Возможный макрос для кнопки или пункта меню:
; ^C^C(if (not C:PAREATAB) (load "pareatab"));PLAREATAB;
(defun C:PAREATLB ( / en cmdname fld txt fc tblset tblobj row col pt
whatAcadVer)
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008
(defun whatAcadVer ( / Aver)
(setq Aver (atof (substr (getvar "ACADVER") 1 4)))
(cond ((= Aver 17.1) 2008)((= Aver 17.0) 2007)((= Aver 16.2) 2006)
((= Aver 16.1) 2005)((= Aver 16.0) 2004)((= Aver 15.06) 2002)
(t 0)))
(vl-load-com)
(or *SCALE* (setq *SCALE* 1))
(or *PREC* (setq *PREC* 2))
(or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
(princ "\nТекущий масштаб = ")(princ *SCALE*)
(princ " Текущая точность округления = ")(princ *PREC*)
(princ " Высота текста = ")(princ *TEXTSIZE*)
(initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
(and
(or ;_ > Проверяем версию
(> (whatAcadVer) 2005)
(alert "\nНужен Автокад версии 2006 и выше")
) ;_ < Проверяем версию
(or ;_ > Запрашиваем что рисовать + опции
(while (= (setq cmdname (getkword "\nВыберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: "))
"Setting")
(princ "\nНовый масштабный коэффициент <")(princ *SCALE*)(princ "> : ")
(initget 6)
(if (setq en (getdist))(setq *SCALE* en))
(princ "\nТочность округления <")(princ *PREC*)(princ "> : ")
(initget 4)
(if (setq en (getint))(setq *PREC* en))
(princ "\nВысота текста <")(princ *TEXTSIZE*)(princ "> : ")
(initget 6)
(if (setq en (getdist))(setq *TEXTSIZE* en))
(initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
)
t
) ;_ < Запрашиваем что рисовать + опции
(cond
((= cmdname "Polyline")(setvar "CMDECHO" 1)(command "_.PLINE")
(while (> (getvar "CMDACTIVE") 0)(command pause))
(setq en (entlast))
)
((or (null cmdname)(= cmdname "sElect"))
(princ "\nВыберите полилинию, круг, сплайн, эллипс или дугу")
(and
(setq tblset (ssget "_:S:E" '((0 . "LINE,*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE"))))
(setq en (ssname tblset 0))
)
)
(t nil)
)
;_ Формируем поле
(setq fld (strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string
(vla-get-objectid (vlax-ename->vla-object en))
) ;_ vl-princ-to-string
">%).Area \\f \"%lu2%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
) ;_ strcat
) ;_ setq
;_ Создаем текст
(setq txt (entmakex
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 72 0) ;_ выравнивание влево
(cons 1 fld)
;(cons 7 style) ;_Текущий стиль
;(cons 8 layer) ;_Текущий слой
(cons 10 '(0 0 0))
(cons 11 '(0 0 0))
(cons 40 *TEXTSIZE*) ;_Высота текста
) ;_ list
) ;_ entmakex
)
;_ Копируем в буфер и обратно
(setvar "cmdecho" 0)
(vl-cmdf "_updatefield" txt "")
(princ "\n Укажите точку вставки текста или ячейку таблицы:")
(vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
;_ В txt примитив текста в pt точка вставки
(setq txt (entlast) pt (getvar "LASTPOINT"))
(or
(and ;_Проверяем, попала ли точка в ячейку таблицы
(setq tblobj nil tblset (ssget "_X" '((0 . "ACAD_TABLE"))))
(setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
(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))
(setq tblobj x)
)
)
)
lst)
tblobj row col
(or (vla-SetText tblobj row col fld) t)
(entdel txt)
)
(and ;_Не попала, рисуем текст с полем
(setq txt (vlax-ename->vla-object txt))
(vlax-write-enabled-p txt)
(vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
(vlax-property-available-p txt 'TextString)
(vlax-put txt 'TextString fld)
)
)
)
(princ)
)

alex (2007-10-01 18:40:41)

Все отлично, однако можно ли добавить следующее:
1. иногда мне надо мм2, а иногда м2, где и как это регулировать?
2. мне бы хотелось высоту буквы по текущему стилю.
3. фон, в который залито число, мне лично мешает
Заранее благодарен, идея отличная!

alex (2007-10-01 19:16:16)

С высотой текста разобрался, а вот:
1. иногда мне надо мм2, а иногда м2, где и как это регулировать?
3. фон, в который залито число, мне лично мешает
Заранее благодарен!

Владимир Громов (2007-10-01 19:21:45)

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

VVA (2007-10-02 09:51:23)

>alex (2007-10-01 19:16:16)
По п.3 команда _options
http://keep4u.ru/imgs/s/071002/c91e527a481b16b59f.jpg' />

по п.1 тебе нужен суффиск м2 и мм2 или преобразовывать число в м2 мм2

wo! (2007-10-02 11:19:23)

Что то у меня никак не получается, в чем дело?
Пишет
Команда: _appload pareatab.lsp успешно загружено.
Команда:
Команда: (if (not C:PAREATAB) (load "pareatab"))
Error:сбой при выполнении LOAD: "pareatab"; ошибка: В функции *error* возникла
ошибка:Настройка переменной AutoCAD отвергнута: "CMDECHO" nil
Команда: PLAREATAB
Неизвестная команда "PLAREATAB". Для вызова справки нажмите F1.
ACAD2006
C уважением, wo!

Незнайка (2007-10-02 18:38:13)

>VVA (2007-09-20 16:36:57)
типа претензии
1. почему по пробелу не повторить
2. можно ли сделать это для протяженности
3. можно ли сделать, чтоб не было необходимости выбирать ячейку, а данные сами подали в таблицу по заранее договоренному условию , т.е сиди и отщелкивай объекты

alex (2007-10-02 22:52:59)

Уважаемый VVA!
"по п.1 тебе нужен суффиск м2 и мм2 или преобразовывать число в м2 мм2"
желательно и то, и другое.
Я понимаю, что для простоты я сделаю два разных лиспа и отдельные кнопки, но где в лиспе добавить м2 или мм2 и где изменить множитель?
Кстати,VVA!Вы мне уже не первый раз помогаете!
Благодарен!

VVA (2007-10-03 10:19:16)

По порядку
>wo! (2007-10-02 11:19:23) и остальные
Я там в примечаниях допустил описку. Нужно читать так !!!

Код:

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

 
; Код можно сохранить в файле pareatlb.lsp
; Возможный макрос для кнопки или пункта меню:
; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;

Это по поводу неизвестная команда PLAREATAB
По поводу
« Error:сбой при выполнении LOAD »

Проверь скобки, особенно в начале и конце. Вожможно не все скопировал.
>Незнайка (2007-10-02 18:38:13)
1. Команда повторяется по пробелу. Или ты имеешь ввиду что-то другое?
2. Поясни, не понял про протяженность?
3. Это как говорится уже другая песТня. Освобожусь, м.б. попробую сделать. Кто и как оговаривает заранее условия?
>alex (2007-10-02 22:52:59)
Про суффиксы и перфиксы: добавлю
Про преюбразование: в команде есть опция "Установки". В ней меняй масштабный коэффициент для мм2 и м2. Можно и в редакторе поля отредактировать масштабный коэффициент.
Для разных масштабов кнопки могут быть такие:
^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;S;0.001;2;5;
Где
0.001 — масштабный коэффициент
2 — точность округления
5 — высота текста
Меняй числа не нужные тебе и клепай кнопки

Незнайка (2007-10-03 13:48:02)

>VVA (2007-10-03 10:19:16)
3. программа запрашивает условия. на что я отвечаю F1 F2. Программа отвечает, что поняла, и пошла мне клепать поля в ячейки F1,F2,F3,F4 , ну и пусть по горизонтали работает. Если я например, дурак и дал ей таблицу на мало строк, то пусть она на законных основаниях вываливается с ошибкой, а еще лучше, чтоб сама ячеек добавила.
2. у полилинии ( разомкнутой) еще есть помимо площади есть параметр протяженность(длина).
1. значит у меня галлюцинации
этот форум стёр мое четвертое предложение:
4.было бы не плохо добавить такую опцию, как простановка в соседней ячейки (E1,E2...)порядкового номера и назначение этого же номера гиперссылкой обработанному примитиву. т.е подвел курсор к примитиву. он посредством гиперссылки говорит что он 66 и смело могу найти его параметры в ячейке F66

VVA (2007-10-03 15:20:31)

>Незнайка (2007-10-03 13:48:02)
1. проехали
2. http://www.autocad.ru/cgi-bin/f1/board.cgi?t=38388nX
3. буду думать
4. попробуй FLDVIZ отсюда http://www.autocad.ru/cgi-bin/f1/boa...38227Nu&page=4. Там правда наоборот. Указыаешь поле (текст, атрибут, ячейку таблицы) и она посвечивает учавствующие примитивы

VVA (2007-10-03 17:18:04)

Вариант с суффиксом и префиксом.
Примерные макросы кнопок для различных масштабов описаны в примечании

Код:

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

 
; Команда: PAREATLB
; Эта команда позволяет вставить в указанную точку рисунка или указанную ячейку таблицы
; текст с полем (FIELD), содержащее значение площади построенного или выбранного контура.
; Точность округления и масштабный коэффициент настраиваются через опцию Установки
; Так как это поле связано с конкретным объектом, то при изменении
; объекта поле пересчитывается (необходимо обновление поля)
; Код можно сохранить в файле pareatlb.lsp
; Возможный макрос для кнопки или пункта меню:
; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;
;; Вариант макроса для задания м2
;; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;S;0.001;2;5;;м2;
;;Где
;; 0.001 — масштабный коэффициент
;; 2 — точность округления
;; 5 — высота текста
;; префикса нет
;; м2 — суффикс
;; Вариант макроса с использованием этого шрифта http://dwg.ru/dnl/147
;; Для м2
;; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;S;0.001;2;5;;/U+E738;
;; Для мм2
;; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;S;0.001;2;5;;м/U+E738;
(defun C:PAREATLB ( / en cmdname fld txt fc tblset tblobj row col pt
whatAcadVer)
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008
(defun whatAcadVer ( / Aver)
(setq Aver (atof (substr (getvar "ACADVER") 1 4)))
(cond ((= Aver 17.1) 2008)((= Aver 17.0) 2007)((= Aver 16.2) 2006)
((= Aver 16.1) 2005)((= Aver 16.0) 2004)((= Aver 15.06) 2002)
(t 0)))
(vl-load-com)
(or *SCALE* (setq *SCALE* 1))
(or *PREC* (setq *PREC* 2))
(or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
(or *SUFF* (setq *SUFF* ""))(or *PREF* (setq *PREF* ""))
(setq *SUFF* (vl-princ-to-string *SUFF*))
(setq *PREF* (vl-princ-to-string *PREF*))
(princ "\nТекущий масштаб = ")(princ *SCALE*)
(princ " Текущая точность округления = ")(princ *PREC*)
(princ " Высота текста = ")(princ *TEXTSIZE*)
(princ " Префикс= ")(princ *PREF*)(princ " Суффикс= ")(princ *SUFF*)
(initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
(and
(or ;_ > Проверяем версию
(> (whatAcadVer) 2005)
(alert "\nНужен Автокад версии 2006 и выше")
) ;_ < Проверяем версию
(or ;_ > Запрашиваем что рисовать + опции
(while (= (setq cmdname (getkword "\nВыберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: "))
"Setting")
(princ "\nНовый масштабный коэффициент <")(princ *SCALE*)(princ "> : ")
(initget 6)
(if (setq en (getdist))(setq *SCALE* en))
(princ "\nТочность округления <")(princ *PREC*)(princ "> : ")
(initget 4)
(if (setq en (getint))(setq *PREC* en))
(princ "\nВысота текста <")(princ *TEXTSIZE*)(princ "> : ")
(initget 6)
(if (setq en (getdist))(setq *TEXTSIZE* en))
(princ "\nПрефикс (пробел — очистить) <")(princ *PREF*)(princ "> : ")
(if (= (setq en (getstring t)) " ")(setq en ""))
(if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
(setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *PREF* en)
(princ "\nСуффикс (пробел — очистить) <")(princ *SUFF*)(princ "> : ")
(if (= (setq en (getstring t)) " ")(setq en ""))
(if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
(setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *SUFF* en)
(initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
)
t
) ;_ < Запрашиваем что рисовать + опции
(cond
((= cmdname "Polyline")(setvar "CMDECHO" 1)(command "_.PLINE")
(while (> (getvar "CMDACTIVE") 0)(command pause))
(setq en (entlast))
)
((or (null cmdname)(= cmdname "sElect"))
(princ "\nВыберите полилинию, круг, сплайн, эллипс или дугу")
(and
(setq tblset (ssget "_:S:E" '((0 . "LINE,*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE"))))
(setq en (ssname tblset 0))
)
)
(t nil)
)
;_ Формируем поле
(setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string(vla-get-objectid (vlax-ename->vla-object en)))
">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
"]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
) ;_ strcat
) ;_ setq
;_ Создаем текст
(setq txt (entmakex
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 72 0) ;_ выравнивание влево
(cons 1 fld)
;(cons 7 style) ;_Текущий стиль
;(cons 8 layer) ;_Текущий слой
(cons 10 '(0 0 0))
(cons 11 '(0 0 0))
(cons 40 *TEXTSIZE*) ;_Высота текста
) ;_ list
) ;_ entmakex
)
;_ Копируем в буфер и обратно
(setvar "cmdecho" 0)
(vl-cmdf "_updatefield" txt "")
(princ "\n Укажите точку вставки текста или ячейку таблицы:")
(vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
;_ В txt примитив текста в pt точка вставки
(setq txt (entlast) pt (getvar "LASTPOINT"))
(or
(and ;_Проверяем, попала ли точка в ячейку таблицы
(setq tblobj nil tblset (ssget "_X" '((0 . "ACAD_TABLE"))))
(setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
(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))
(setq tblobj x)
)
)
)
lst)
tblobj row col
(or (vla-SetText tblobj row col fld) t)
(entdel txt)
)
(and ;_Не попала, рисуем текст с полем
(setq txt (vlax-ename->vla-object txt))
(vlax-write-enabled-p txt)
(vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
(vlax-property-available-p txt 'TextString)
(vlax-put txt 'TextString fld)
)
)
)
(princ)
)

alex (2007-10-03 21:09:39)

Уменя неработает след.:
со второго раза по умолчанию видит суффикс и префикс предыдущие, а на экран их не выдает.
а вообще лисп классный!

alex (2007-10-03 21:20:04)

К предыдущему письму:
имеется ввиду если во второй раз заказать "установки" и по умолчанию со всем согласиться.

VVA (2007-10-04 10:26:53)

>alex (2007-10-03 21:20:04)
Исправил

Код:

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

 
; Команда: PAREATLB
; Эта команда позволяет вставить в указанную точку рисунка или указанную ячейку таблицы
; текст с полем (FIELD), содержащее значение площади построенного или выбранного контура.
; Точность округления и масштабный коэффициент настраиваются через опцию Установки
; Так как это поле связано с конкретным объектом, то при изменении
; объекта поле пересчитывается (необходимо обновление поля)
; Код можно сохранить в файле pareatlb.lsp
; Возможный макрос для кнопки или пункта меню:
; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;
;; Вариант макроса для задания м2
;; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;S;0.001;2;5;;м2;
;;Где
;; 0.001 — масштабный коэффициент
;; 2 — точность округления
;; 5 — высота текста
;; префикса нет
;; м2 — суффикс
;; Вариант макроса с использованием этого шрифта http://dwg.ru/dnl/147
;; Для м2
;; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;S;0.001;2;5;;/U+E738;
;; Для мм2
;; ^C^C(if (not C:PAREATLB) (load "pareatlb"));PAREATLB;S;0.001;2;5;;м/U+E738;
(defun C:PAREATLB ( / en cmdname fld txt fc tblset tblobj row col pt
whatAcadVer)
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008
(defun whatAcadVer ( / Aver)
(setq Aver (atof (substr (getvar "ACADVER") 1 4)))
(cond ((= Aver 17.1) 2008)((= Aver 17.0) 2007)((= Aver 16.2) 2006)
((= Aver 16.1) 2005)((= Aver 16.0) 2004)((= Aver 15.06) 2002)
(t 0)))
(vl-load-com)
(or *SCALE* (setq *SCALE* 1))
(or *PREC* (setq *PREC* 2))
(or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
(or *SUFF* (setq *SUFF* ""))(or *PREF* (setq *PREF* ""))
(setq *SUFF* (vl-princ-to-string *SUFF*))
(setq *PREF* (vl-princ-to-string *PREF*))
(princ "\nТекущий масштаб = ")(princ *SCALE*)
(princ " Текущая точность округления = ")(princ *PREC*)
(princ " Высота текста = ")(princ *TEXTSIZE*)
(princ " Префикс= ")(princ *PREF*)(princ " Суффикс= ")(princ *SUFF*)
(initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
(and
(or ;_ > Проверяем версию
(> (whatAcadVer) 2005)
(alert "\nНужен Автокад версии 2006 и выше")
) ;_ < Проверяем версию
(or ;_ > Запрашиваем что рисовать + опции
(while (= (setq cmdname (getkword "\nВыберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: "))
"Setting")
(princ "\nНовый масштабный коэффициент <")(princ *SCALE*)(princ "> : ")
(initget 6)
(if (setq en (getdist))(setq *SCALE* en))
(princ "\nТочность округления <")(princ *PREC*)(princ "> : ")
(initget 4)
(if (setq en (getint))(setq *PREC* en))
(princ "\nВысота текста <")(princ *TEXTSIZE*)(princ "> : ")
(initget 6)
(if (setq en (getdist))(setq *TEXTSIZE* en))
(princ "\nПрефикс (пробел — очистить) <")(princ *PREF*)(princ "> : ")
(setq en (getstring t))(if (= en "")(setq en *PREF*))
(if (= en " ")(setq en ""))
(if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
(setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *PREF* en)
(princ "\nСуффикс (пробел — очистить) <")(princ *SUFF*)(princ "> : ")
(setq en (getstring t))(if (= en "")(setq en *SUFF*))
(if (= en " ")(setq en ""))
(if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
(setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *SUFF* en)
(initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
)
t
) ;_ < Запрашиваем что рисовать + опции
(cond
((= cmdname "Polyline")(setvar "CMDECHO" 1)(command "_.PLINE")
(while (> (getvar "CMDACTIVE") 0)(command pause))
(setq en (entlast))
)
((or (null cmdname)(= cmdname "sElect"))
(princ "\nВыберите полилинию, круг, сплайн, эллипс или дугу")
(and
(setq tblset (ssget "_:S:E" '((0 . "LINE,*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE"))))
(setq en (ssname tblset 0))
)
)
(t nil)
)
;_ Формируем поле
(setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string(vla-get-objectid (vlax-ename->vla-object en)))
">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
"]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
) ;_ strcat
) ;_ setq
;_ Создаем текст
(setq txt (entmakex
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 72 0) ;_ выравнивание влево
(cons 1 fld)
;(cons 7 style) ;_Текущий стиль
;(cons 8 layer) ;_Текущий слой
(cons 10 '(0 0 0))
(cons 11 '(0 0 0))
(cons 40 *TEXTSIZE*) ;_Высота текста
) ;_ list
) ;_ entmakex
)
;_ Копируем в буфер и обратно
(setvar "cmdecho" 0)
(vl-cmdf "_updatefield" txt "")
(princ "\n Укажите точку вставки текста или ячейку таблицы:")
(vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
;_ В txt примитив текста в pt точка вставки
(setq txt (entlast) pt (getvar "LASTPOINT"))
(or
(and ;_Проверяем, попала ли точка в ячейку таблицы
(setq tblobj nil tblset (ssget "_X" '((0 . "ACAD_TABLE"))))
(setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
(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))
(setq tblobj x)
)
)
)
lst)
tblobj row col
(or (vla-SetText tblobj row col fld) t)
(entdel txt)
)
(and ;_Не попала, рисуем текст с полем
(setq txt (vlax-ename->vla-object txt))
(vlax-write-enabled-p txt)
(vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
(vlax-property-available-p txt 'TextString)
(vlax-put txt 'TextString fld)
)
)
)
(princ)
)

alex (2007-10-05 21:18:05)

Все работает корректно,спасибо!

alex (2007-10-11 20:24:38)

Александр!
Вопрос параллельно с VVA.
А можно ли суффикс и префикс писать другим фонтом, отдельным от числового значения?
Спасибо!

VVA (2007-10-17 10:00:33)

>alex (2007-10-11 20:24:38)
« А можно ли суффикс и префикс писать другим фонтом, отдельным от числового значения »

Нет, т.к. суффикс и префикс свойство поля. А там такой возможности не предусмотрено. Если бы суффикс был задан текстом (в мтексте) то проблем не вижу.
>iv (2007-10-11 11:50:47)
1. В опции установка заждай масштабный коэффициент 0.00001 или я не так понял?
2. Текст создается entmake. Для наклона нужно добавить поле 51 типа '(51 . 0.261799), где 0.261799 — угол наклона в радианах
Либо этот кусок кода

Код:

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

 
;_ Создаем текст
(setq txt (entmakex
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 72 0) ;_ выравнивание влево
(cons 1 fld)
;(cons 7 style) ;_Текущий стиль
;(cons 8 layer) ;_Текущий слой
(cons 10 '(0 0 0))
(cons 11 '(0 0 0))
(cons 40 *TEXTSIZE*) ;_Высота текста
) ;_ list
) ;_ entmakex
)

Засменить на этот

Код:

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

 
(setq tstyle (getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
;_ Создаем текст
(if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
;; нулевая высота текста
(vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 fld)
(vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0 fld)
) ;_ end of if
(setq txt (entlast))

Причем в этой строке
(getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
можно задать свой УЖЕ СУЩЕСТВУЮЩИЙ стиль
типа
(setq tstyle "Стиль1")
3. Можно на кнопочке перед вызовом PAREATLB добавить что-то типа
_-LAYER;_M;Новый_слой_текста;PAREATLB и т.д.

[VVA]

;;;; Команда: AREATT (AREA To Table) ;;;; posted http://dwg.ru/f/showthread.php?t=14528 ;;;; Эта команда позволяет вставлять начиная с указанной ячейки таблицы ;;;; текст с полем (FIELD), содержащее значение площади выбранного контура. ;;;; В зависимости от выбора, навигация по таблице идет по строкам или столбцам. ;;;; Если строки или столбцы заканчиваются, то они автоматически добавляются. ;;;; Форматирование ячейки берется как у первой указанной. ;;;; Точность округления и масштабный коэффициент настраиваются через опцию Установки ;;;; Так как это поле связано с конкретным объектом, то при изменении ;;;; объекта поле пересчитывается (необходимо обновление поля) ;;;; Код можно сохранить в файле areatt.lsp ;;;; Возможный макрос для кнопки или пункта меню: ;;;; ^C^C(if (not C:AREATT)(load "AREATT"));AREATT;

Спасибо Владимир Громов (Profan на этом форуме) что начал потихоньку вытаскивать интересные темы. Мне показалась интересной идея Незнайки

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

Но пока до нее дошли руки, autocad.ru начало колбасить. Продолжаю тему здесь.
Кратко суть работы:
Щелчком мыши внутри указываешь с какой ячейки таблицы начинать, выбираешь способ навигации (по строкам или столбцам), далее выбираешь объекты и их площади автоматом попадают в соответствии с установками и выбранным способом навигации в соответствующие строки или столбцы таблицы. Если строки или столбцы заканчиваются, то они добавляются.

Код:

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

;  Команда: AREATT (AREA To Table)
;  posted http://dwg.ru/f/showthread.php?t=14528
;  Эта команда позволяет вставлять начиная с указанной ячейки таблицы
;  текст с полем (FIELD), содержащее значение площади выбранного контура.
;  В зависимости от выбора, навигация по таблице идет по строкам или столбцам.
;  Если стороки или столбцы заканчиваются, то они автоматически добавляются.
;  Форматирование ячейки берется как у первой указанной.
;  Точность округления и масштабный коэффициент настраиваются через опцию Установки
;  Так как это поле связано с конкретным объектом, то при изменении
;  объекта поле пересчитывается (необходимо обновление поля)
;  Код можно сохранить в файле areatt.lsp
;  Возможный макрос для кнопки или пункта меню:
;  ^C^C(if (not C:AREATT)(load "AREATT"));AREATT;

(defun C:AREATT ( / en obj tblobj row col lst pt rows cols what fld)
  (vl-load-com)
  (or *SCALE* (setq *SCALE* 1))
  (or *PREC* (setq *PREC* 2))
  (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (or *SUFF* (setq *SUFF* ""))(or *PREF* (setq *PREF* ""))
  (setq *SUFF* (vl-princ-to-string *SUFF*))
  (setq *PREF* (vl-princ-to-string *PREF*))
  (princ "\nТекущий масштаб = ")(princ *SCALE*)
  (princ " Текущая точность округления = ")(princ *PREC*)
  (princ " Высота текста = ")(princ *TEXTSIZE*)
  (princ " Префикс= ")(princ *PREF*)(princ " Суффикс= ")(princ *SUFF*)
 (and
  (setq  tblobj nil tblobj (ssget "_X" '((0 . "ACAD_TABLE"))))
  (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblobj)))))
)
  (setq  tblobj nil)
  (cond
   ((and lst
         (or (initget "Row Col Setting стРоки сТолбцы Установки _Row Col Setting Row Col Setting") t)
         (or (while (=(setq what (getkword "\nПеремещаться [по стРокам/по сТолбцам/Установки] <по сТолбцам>: "))
                      "Setting")
                     (princ "\nНовый масштабный коэффициент <")(princ *SCALE*)(princ "> : ")
      (initget 6)
      (if (setq en (getdist))(setq *SCALE* en))
      (princ "\nТочность округления <")(princ *PREC*)(princ "> : ")
      (initget 4)
      (if (setq en (getint))(setq *PREC* en))
      (princ "\nВысота текста <")(princ *TEXTSIZE*)(princ "> : ")
      (initget 6)
      (if (setq en (getdist))(setq *TEXTSIZE* en))
      (princ "\nПрефикс (пробел - очистить) <")(princ *PREF*)(princ "> : ")
      (if (= (setq en (getstring t)) " ")(setq en ""))
      (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
      (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *PREF* en)
      (princ "\nСуффикс (пробел - очистить) <")(princ *SUFF*)(princ "> : ")
      (if (= (setq en (getstring t)) " ")(setq en ""))
      (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
      (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *SUFF* en)
               (initget "Row Col Setting стРоки сТолбцы Установки _Row Col Setting Row Col Setting")
               )
             t
             )
         (or what (setq what "Col"))
         (or
        (while (null  tblobj)
          (initget 1)
          (setq pt (getpoint "\nУкажите ячейку таблицы:"))
          (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))
                 (setq tblobj x)
                 )
               )
           )
        lst)
          (if (null  tblobj)(princ " ** мимо **"))
          )
        t)
         (or
           (vlax-write-enabled-p tblobj)
           (and
             (princ "\nТаблица на заблокированном слое!")
             nil
             )
           )
         (setq pt (vla-GetCellAlignment tblobj row col))
         )
    (setq rows (vla-get-rows tblobj))
    (setq cols (vla-get-columns tblobj))
    (while (setq en (car (entsel "\nВыберите примитив для вставки его площади в таблицу (ENTER — завершение): " )))
      (cond
       ((vlax-property-available-p (setq en (vlax-ename->vla-object en)) 'Area)
          (setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(Get-ObjectID-x86-x64 en))
                ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
                ) ;_ strcat
          )
        (cond
          ((= col cols)
            (vla-insertColumns tblobj col (vla-GetColumnWidth tblobj (1- col)) 1)
            (vla-SetCellAlignment tblobj row col pt)
            (setq rows (vla-get-rows tblobj))
            (setq cols (vla-get-columns tblobj))
            
          )
          ((= row rows)
            (vla-insertRows tblobj row (vla-GetRowHeight tblobj (1- row)) 1)
           (vla-SetCellAlignment tblobj row col pt)
            (setq rows (vla-get-rows tblobj))
            (setq cols (vla-get-columns tblobj))
         )
          (t nil))
        (vla-SetText tblobj row col fld)
        (if (= what "Col")(setq col (1+ col))(setq row (1+ row)))
        
       )
       (t(princ "\nДля этого примитива невозможно получить свойство Area!"))
      )
      
    )
   )
   (t
     (princ "\nТаблиц не найдено!")
   )
  )
  (princ)
)

;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(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)
     )
  )
)

Обновлено 2012-05-16

Код:

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

;;; Вариант с суммированием
;;;;  Команда: AREATT (AREA To Table)
;;;;  posted http://dwg.ru/f/showthread.php?t=14528
;;;;  Эта команда позволяет вставлять начиная с указанной ячейки таблицы
;;;;  текст с полем (FIELD), содержащее значение площади выбранного контура.
;;;;  В зависимости от выбора, навигация по таблице идет по строкам или столбцам.
;;;;  Если строки или столбцы заканчиваются, то они автоматически добавляются.
;;;;  Форматирование ячейки берется как у первой указанной.
;;;;  Точность округления и масштабный коэффициент настраиваются через опцию Установки
;;;;  Так как это поле связано с конкретным объектом, то при изменении
;;;;  объекта поле пересчитывается (необходимо обновление поля)
;;;;  Код можно сохранить в файле areatt.lsp
;;;;  Возможный макрос для кнопки или пункта меню:
;;;;  ^C^C(if (not C:AREATT)(load "AREATT"));AREATT;
;;;; 16.05.2012 Добавлена настройка разделителя (точка запятая)

(defun C:AREATT ( / en obj tblobj row col lst pt rows cols what fld str)
  (vl-load-com)
  (or *SCALE* (setq *SCALE* 1))
  (or *PREC* (setq *PREC* 2))
  (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (or *SUFF* (setq *SUFF* ""))(or *PREF* (setq *PREF* ""))
  (setq *SUFF* (vl-princ-to-string *SUFF*))
  (setq *PREF* (vl-princ-to-string *PREF*))
  (princ "\nТекущий масштаб = ")(princ *SCALE*)
  (princ " Текущая точность округления = ")(princ *PREC*)
  (princ " Высота текста = ")(princ *TEXTSIZE*)
  (princ " Префикс= ")(princ *PREF*)(princ " Суффикс= ")(princ *SUFF*)
  (princ " Разделитель=")(princ (if *DSEP* "запятая" "точка"))
  ;;;(setq  tblobj nil tblobj (ssget "_X" '((0 . "ACAD_TABLE"))))
  (and
  (setq  tblobj nil tblobj (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
  (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblobj)))))
  )
  (setq  tblobj nil)
  (cond
   ((and lst
         (or (initget "Row Col Setting стРоки сТолбцы Установки _Row Col Setting Row Col Setting") t)
         (or (while (=(setq what (getkword "\nПеремещаться [по стРокам/по сТолбцам/Установки] <по сТолбцам>: "))
                      "Setting")
                     (princ "\nНовый масштабный коэффициент <")(princ *SCALE*)(princ "> : ")
      (initget 6)
      (if (setq en (getdist))(setq *SCALE* en))
      (princ "\nТочность округления <")(princ *PREC*)(princ "> : ")
      (initget 4)
      (if (setq en (getint))(setq *PREC* en))
      (princ "\nВысота текста <")(princ *TEXTSIZE*)(princ "> : ")
      (initget 6)
      (if (setq en (getdist))(setq *TEXTSIZE* en))
      (princ "\nПрефикс (пробел - очистить) <")(princ *PREF*)(princ "> : ")
      (if (= (setq en (getstring t)) " ")(setq en ""))
      (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
      (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *PREF* en)
      (princ "\nСуффикс (пробел - очистить) <")(princ *SUFF*)(princ "> : ")
      (if (= (setq en (getstring t)) " ")(setq en ""))
      (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
      (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *SUFF* en)
      (princ (strcat "\nРазделитель дробной части [Точка/Запятая] <"(if *DSEP* "запятая" "точка")">:"))
      (initget "Точка Запятая")
      (setq en (getkword))
      (cond ((eq en "Запятая")(setq *DSEP* t))((eq en "Точка")(setq *DSEP* nil))(t nil))
               (initget "Row Col Setting стРоки сТолбцы Установки _Row Col Setting Row Col Setting")
               )
             t
             )
         (or what (setq what "Col"))
         (or
        (while (null  tblobj)
          (initget 1)
          (setq pt (getpoint "\nУкажите ячейку таблицы:"))
          (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))
                 (setq tblobj x)
                 )
               )
           )
        lst)
          (if (null  tblobj)(princ " ** мимо **"))
          )
        t)
         (or
           (vlax-write-enabled-p tblobj)
           (and
             (princ "\nТаблица на заблокированном слое!")
             nil
             )
           )
         (setq pt (vla-GetCellAlignment tblobj row col))
         )
    (setq rows (vla-get-rows tblobj))
    (setq cols (vla-get-columns tblobj))
    (initget "+ -")
    (while (setq en (entsel "\nВыберите примитив для вставки его площади в таблицу (+ сумма; - вычитание; ENTER — завершение): " ))
      (if (listp en)(setq en (car en)))
      (setq fld nil)
      (cond
       ((member en '("+" "-"))
	(setq str en fld "%<\\AcExpr (" lst nil)
	(while (setq en (car(entsel
			  (strcat "\n" (if (= str "+") "СУММИРОВАНИЕ > " "ВЫЧИТАНИЕ > ")
					 "Выберите примитив для вставки его площади в таблицу (ENTER — завершение): " ))
		     ))
	  (if (vlax-property-available-p (setq en (vlax-ename->vla-object en)) 'Area)
	    (progn
	      (setq lst (cons en lst))
	      (vla-Highlight en :vlax-true)
	   (setq fld (strcat fld "%<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(Get-ObjectID-x86-x64 en))
                ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%pr"(itoa *PREC*)(if *DSEP* "%ds44" "") "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
		str	     
                ) ;_ strcat
		 )
	   )
	    (princ "\nДля этого примитива невозможно получить свойство Area!")
	    )
	  )
	(mapcar '(lambda(x)(vla-Highlight x :vlax-false)) lst)
	(setq fld (strcat (vl-string-right-trim str fld) ") \\f \"%lu2%ps["*PREF* "," *SUFF* 
                "]%pr"(itoa *PREC*)(if *DSEP* "%ds44" "") "%ct8["(vl-princ-to-string *SCALE*)"]\">%"))
	)
       ((vlax-property-available-p (setq en (vlax-ename->vla-object en)) 'Area)
          (setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(Get-ObjectID-x86-x64 en))
                ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%pr"(itoa *PREC*)(if *DSEP* "%ds44" "") "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
                ) ;_ strcat
          )
       )
       (t(princ "\nДля этого примитива невозможно получить свойство Area!"))
      )
      (if (= (type fld) 'STR)
	(progn
	  (cond
          ((= col cols)
            (vla-insertColumns tblobj col (vla-GetColumnWidth tblobj (1- col)) 1)
            (vla-SetCellAlignment tblobj row col pt)
            (setq rows (vla-get-rows tblobj))
            (setq cols (vla-get-columns tblobj))
            
          )
          ((= row rows)
            (vla-insertRows tblobj row (vla-GetRowHeight tblobj (1- row)) 1)
           (vla-SetCellAlignment tblobj row col pt)
            (setq rows (vla-get-rows tblobj))
            (setq cols (vla-get-columns tblobj))
         )
          (t nil))
        (vla-SetText tblobj row col fld)
        (if (= what "Col")(setq col (1+ col))(setq row (1+ row)))
	  )
	)
     (initget "+ -")
    )
   )
   (t
     (princ "\nТаблиц не найдено!")
   )
  )
  (princ)
)
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(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)
     )
  )
)

Вариант, где при суммировании или вычитании используется выбор объектов ssget'ом.
Это дает возможность выбирать рамкой, секрамкой или группой, если объекты предварительно сгруппировать командой _GROUP
Остальное здесь: ATTSS (AREA To Table with Sum and Select))

[VVA]

Вариант команды PAREATLB вставляет в таблицу тест с длиной примитива или площадью

Код:

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

;  Команда: PTLB
;  Эта команда позволяет вставить в указанную точку рисунка или указанную ячейку таблицы
;  текст с полем (FIELD), содержащее значение площади или длины построенного или выбранного контура.
;  Точность округления и масштабный коэффициент настраиваются через опцию Установки
;  Так как это поле связано с конкретным объектом, то при изменении
;  объекта поле пересчитывается (необходимо обновление поля)
;  Код можно сохранить в файле ptlb.lsp
;  Возможный макрос для кнопки или пункта меню:
;  ^C^C(if (not C:PTLB) (load "ptlb"));PTLB;
;; Вариант макроса для задания м2
;; ^C^C(if (not C:PTLB) (load "ptlb"));PTLB;_L;_S;1;0.001;2;3;5;;м2;
;;Где
;; _L - считать длинну (_A - площадь)
;; _S - установки
;; 1 - линейный масштабный коэффициент
;; 0.001 — площадной масштабный коэффициент
;; 2 — точность представления чисел
;; 3 - Кратность округления (0-Нет)
;; 5 — высота текста
;; префикса нет
;; м2 - суффикс

(defun C:PTLB ( / en cmdname fld txt fc tblset tblobj row col pt
                 whatAcadVer tstyle what *error* layer-status-save
               layer-status-restore
               )
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008
(defun whatAcadVer ( / Aver)
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008 2009
(setq Aver (atof (substr (getvar "ACADVER") 1 4)))
(cond
((= Aver 18.2) 2012)  
((= Aver 18.1) 2011)  
((= Aver 18.0) 2010)  
((= Aver 17.2) 2009)
((= Aver 17.1) 2008)
((= Aver 17.0) 2007)
((= Aver 16.2) 2006)    
((= Aver 16.1) 2005)
((= Aver 16.0) 2004)
((= Aver 15.06) 2002)
(t 2013)
)
)
  (defun _round (num prec)
  (cond ((zerop prec) num)
        (t
         (* prec
            (if (minusp num)
              (fix (- (/ num prec) 0.5))
              (fix (+ (/ num prec) 0.5))
              )
            )
         )
        )
)
  (defun *error* (msg)(layer-status-restore)
    (princ msg)(princ))
  (defun layer-status-save ()
    (setq *MIP_LAYER_LST* nil)
    (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) 
      (setq *MIP_LAYER_LST* (cons (list item 
                                  (cons "lock" (vla-get-lock item)) 
                                  ) ;_ end of cons 
                            *MIP_LAYER_LST* 
                            ) ;_ end of cons 
            ) ;_ end of setq 
      (vla-put-lock item :vlax-false)
      ) ;_ end of vlax-for
      
    );_ end of defun
(defun layer-status-restore () 
    (foreach item *MIP_LAYER_LST*
      (if (not (vlax-erased-p (car item))) 
        (vl-catch-all-apply 
          '(lambda () 
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
             ) ;_ end of lambda 
          ) ;_ end of vl-catch-all-apply 
        ) ;_ end of if 
      ) ;_ end of foreach
    (setq *MIP_LAYER_LST* nil)
    ) ;_ end of defun 
  (vl-load-com)
  (or *SCALEL* (setq *SCALEL* 1))
  (or *SCALEA* (setq *SCALEA* 1))
  (or *PREC* (setq *PREC* 2))
  (or *OKR* (setq *OKR* 0))
  (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (or *SUFF* (setq *SUFF* ""))(or *PREF* (setq *PREF* ""))
  (setq *SUFF* (vl-princ-to-string *SUFF*))
  (setq *PREF* (vl-princ-to-string *PREF*))
  (and
    (or ;_ > Проверяем версию
      (> (whatAcadVer) 2005)
      (alert "\nНужен Автокад версии 2006 и выше")
      ) ;_ < Проверяем версию
    (or (initget "Length Area Длина Площадь _Length Area Length Area") t)
    (if (null (setq what (getkword "\nЧто будем считать [Длина/Площадь] <Длина> :")))
      (setq what "Length") t)
      (princ "\nТекущий масштаб: линейный = ")(princ *SCALEL*)(princ " площадной = ")(princ *SCALEA*)
      (princ " Точность = ")(princ *PREC*)
      (princ " Кратность округления =")(princ (if (zerop *OKR*) "нет" *OKR*))
      (princ " Высота текста = ")(princ *TEXTSIZE*)
      (princ " Префикс= ")(princ *PREF*)(princ " Суффикс= ")(princ *SUFF*)
    (or
      (initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
      t
      )
    (or ;_ > Запрашиваем что рисовать + опции
    (while (= (setq cmdname (getkword (strcat (if (= what "Area") "\n<Площадь> " "\n<Длина> ")
           "Выберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: ")))
              "Setting")
      (princ "\nНовый линейный масштабный коэффициент <")(princ *SCALEL*)(princ "> : ")
      (initget 6)
      (if (setq en (getdist))(setq *SCALEL* en))
      (princ "\nНовый площадной масштабный коэффициент <")(princ *SCALEA*)(princ "> : ")
      (initget 6)
      (if (setq en (getdist))(setq *SCALEA* en))
      (princ "\nТочность представления чисел <")(princ *PREC*)(princ "> : ")
      (initget 4)
      (if (setq en (getint))(setq *PREC* en))
      (princ "Кратность округления (0-Нет) <")(princ (if (zerop *OKR*) "нет" *OKR*))(princ "> : ")
      (initget 4)
      (if (setq en (getreal))(setq *OKR* en))
      (princ "\nВысота текста <")(princ *TEXTSIZE*)(princ "> : ")
      (initget 6)
      (if (setq en (getdist))(setq *TEXTSIZE* en))
      (princ "\nПрефикс (пробел - очистить) <")(princ *PREF*)(princ "> : ")
      (setq en (getstring t))(if (= en "")(setq en *PREF*))
      (if (= en " ")(setq en ""))
      (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
      (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *PREF* en)
      (princ "\nСуффикс (пробел - очистить) <")(princ *SUFF*)(princ "> : ")
      (setq en (getstring t))(if (= en "")(setq en *SUFF*))
      (if (= en " ")(setq en ""))
      (if (= (substr (vl-string-left-trim "\/" en) 1 2) "U+")
      (setq en (strcat "\\" (vl-string-left-trim "\/" en))))(setq *SUFF* en)
      (initget "Polyline Setting sElect Полилиния Установки Выбор _Polyline Setting sElect Polyline Setting sElect")
      )
    t
    ) ;_ < Запрашиваем что рисовать + опции
   (or (layer-status-save) t)
  (cond
    ((= cmdname "Polyline")(setvar "CMDECHO" 1)(command "_.PLINE")
     (while (> (getvar "CMDACTIVE") 0)(command pause))
     (setq en (entlast))
     )
    ((or (null cmdname)(= cmdname "sElect"))
         (princ "\nВыберите полилинию, круг, сплайн, эллипс или дугу")
         (and
           (setq tblset (ssget "_:S:E" (if (= what "Area") '((0 . "*POLYLINE,ARC,SPLINE,ELLIPSE,CIRCLE"))
                                                           '((0 . "LINE,*POLYLINE,ARC,CIRCLE")))
                                         ))
           (setq en (ssname tblset 0))
           )
     )
    (t nil)
    )
  ;_ Формируем поле
  (cond
    ((= what "Area")
     (setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId "
             (vl-princ-to-string(Get-ObjectID-x86-x64 (vlax-ename->vla-object en)))
                ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEA*)"]\">%"
                ) ;_ strcat
          ) ;_ setq
     )
    ((and (= what "Length")
          (= (cdr(assoc 0 (entget en))) "CIRCLE")
          )
     (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (Get-ObjectID-x86-x64 (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Circumference \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEA*)"]\">%"
                ) ;_ strcat
          ) ;_ setq
     )
    ((and (= what "Length")
          (= (cdr(assoc 0 (entget en))) "ARC")
          )
     (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (Get-ObjectID-x86-x64 (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).ArcLength \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEA*)"]\">%"
                ) ;_ strcat
          ) ;_ setq
     )
    ((and (= what "Length")
          (vlax-property-available-p (vlax-ename->vla-object en) "Length")
          )
     (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (Get-ObjectID-x86-x64 (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Length \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEA*)"]\">%"
                ) ;_ strcat
          ) ;_ setq
     )
    (t (setq fld "Неизвестное свойство"))
    )
;;;Округляем
   (if (not (zerop *OKR*))
     (setq fld
            (strcat
              "%<\\AcExpr ((Trunc("
              (substr fld 1 (1-(vl-string-search "\\f" fld)))
              ">%"
              " / "
              (vl-prin1-to-string *OKR*)
              " + 0.5"
              "))*"
              (vl-prin1-to-string *OKR*)
              ")"
              (substr fld (vl-string-search "\\f" fld))
              ;;">%"
              )
           )
     t
     )
(setvar "cmdecho" 0)
(setq tstyle (getvar "TEXTSTYLE")) ;_Стиль текста Стиль должен существовать
    ;_ Создаем текст
(if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
     ;; нулевая высота текста
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 fld)
   (vl-cmdf "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0 fld)
   ) ;_ end of if
    (setq txt (entlast))
  ;_ Копируем в буфер и обратно
  (vl-cmdf "_updatefield" txt "")
  (princ "\n Укажите точку вставки текста или ячейку таблицы:")
  (vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)
  ;_ В txt примитив текста в pt точка вставки  
  (setq txt (entlast) pt (getvar "LASTPOINT"))
  (or
    (and ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (progn
        (vl-catch-all-apply '(lambda()
        (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))
                 (setq tblobj x)
                 )
               )
           )
        lst)
                               )
          )
        tblobj
        )
       row col
      (or (vla-SetText tblobj row col fld) t)
      (entdel txt)
      )
    (and ;_Не попала, рисуем текст с полем
      (setq txt (vlax-ename->vla-object txt))
      (vlax-write-enabled-p txt)
      (vlax-method-applicable-p txt 'FieldCode) ;_есть метод FieldCode
      (vlax-property-available-p txt 'TextString)
      (vlax-put txt 'TextString fld)
      )
    )
  )
  (layer-status-restore)
  (princ)
  )
(princ "\nКоманда PTLB. Версия от 20.04.2011 http://forum.dwg.ru/showpost.php?p=183237&postcount=3")
(princ)

;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(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)
     )
  )
)
(princ "\nКоманда PTLB. Версия от 19.03.2012 http://forum.dwg.ru/showpost.php?p=183237&postcount=3")
(princ)

Еще ссылки
Вариант PAREATLB с подчеркиванием
MAREATT
исправленная PAREATLB из #1
Вариант PTLB для мебели (BOXTLB)
Вариант PTLB для размеров (DIMTLB)

[gabrin]

Очень интересная тема. Давно бъюсь над задачей ( как раз в тему топика ). При проектировании мои полилинии имеют несколько ключевых для меня свойств - это слой, тип линии,длина и значение Z. Никак не удается написать лисп , который рисовал бы таблицу из 4-х строк, в которой бы в "Поле" вписывал эти самые ключевые свойства. Если кто знает как это можно осуществить, буду весьма признателен.

[VVA]

Полилинии какие: LWPOLYLINE, 2DPOLYLINE, 3DPOLYLINE. От этого зависит, где искать координату Z
Сами поля для твоих свойств

Код:

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

(setq *PREC* 2) ;_точность округления
(setq *SCALEL* 1);_масштабный коэффициент
(vl-load-com)
(defun C:TEST ()
(if  
(and
  (setq en (car(entsel "\nУкажи полилинию")))
  (= (cdr(assoc 0 (entget en))) "LWPOLYLINE")
  )
(progn
;;Длина
(setq fld_Len (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Length \\f \"%lu2%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEL*)"]\">%"
                ) ;_ strcat
          ) ;_ setq
;;Уровень (Z)
(setq fld_Z (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Elevation \\f \"%lu2%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEL*)"]\">%"
                ) ;_ strcat
          ) ;_ setq

;;Слой
(setq fld_lay (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Layer>%"
                ) ;_ strcat
          ) ;_ setq

;;Тип линии
(setq fld_LT (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Linetype>%"
                ) ;_ strcat
          ) ;_ setq
(princ "\nПоле-длина: ")(princ fld_len)
(princ "\nПоле-уровень: ")(princ fld_Z)  
(princ "\nПоле-слой: ")(princ fld_lay)
(princ "\nПоле-тип линии: ")(princ fld_lt)
)
(princ "\Объект не полилиния")
)
(princ)
  )

[gabrin]

В моем случае я использую 3DPolyline

[gabrin]

Хороший Лисп, как раз то что нужно. Последний вопрос- Как сделать чтобы все это выводилось в одну таблицу на экран?

[VVA]

Сообщение от gabrin В моем случае я использую 3DPolyline

У 3d полилинии нет свойства "Уровень", соответственно полем на координату Z не сослаться

[gabrin]

Сообщение от VVA У 3d полилинии нет свойства "Уровень", соответственно полем на координату Z не сослаться

Дело в том что я пользуюсь Лиспом прокладки 3DPolyline на разных отметках с опусками и подъемами. С уровнем я уже понял. Возможно переделать ваш Лисп под 3DPolyline?

[VVA]

Остальные (кроме Уровня) свойства есть у любых полилиний. Поэтому без разницы 3d или нет

Код:

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

(setq *PREC* 2) ;_точность округления
(setq *SCALEL* 1);_масштабный коэффициент
(vl-load-com)
(defun C:TEST1 ()
(if  
(and
  (setq en (car(entsel "\nУкажи полилинию")))
  (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE")
  )
(progn
;;Длина
(setq fld_Len (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Length \\f \"%lu2%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEL*)"]\">%"
                ) ;_ strcat
          ) ;_ setq
;;Слой
(setq fld_lay (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Layer>%"
                ) ;_ strcat
          ) ;_ setq

;;Тип линии
(setq fld_LT (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Linetype>%"
                ) ;_ strcat
          ) ;_ setq
(princ "\nПоле-длина: ")(princ fld_len)
(princ "\nПоле-слой: ")(princ fld_lay)
(princ "\nПоле-тип линии: ")(princ fld_lt)
)
(princ "\Объект не полилиния")
)
(princ)
  )

[DonJad]

to VVA
листинг выполнения для полилинии:

Command: test Укажи полилинию Поле-длина: %<\AcObjProp Object(%<\_ObjId 1962289528>%).Length \f "%lu2%pr2%ct8[1]">% Поле-уровень: %<\AcObjProp Object(%<\_ObjId 1962289528>%).Elevation \f "%lu2%pr2%ct8[1]">% Поле-слой: %<\AcObjProp Object(%<\_ObjId 1962289528>%).Layer>% Поле-тип линии: %<\AcObjProp Object(%<\_ObjId 1962289528>%).Linetype>% Command:

Acad2007... чет не работает. что первый что второй вариант.
Что вообще этот лисп делает?

[VVA]

DonJad, Сами команды опубликованы в #1,2,3 (различные варианты)
Лисп работает правильно. Он печатает тебе значения полей указанной полилинии. Если скопировать в буфер тест %< ... >% и вставить в рекакторе текста, то получись поле со ссылкой на соотв. свойство (длину, стлой или тип линии)

[acyxou]

Уважаемый VVA, как сделать так чтоб лисп в 2009-ом Автокаде работал?
Заранее спасибо за ответ.

[VVA]

acyxou, Нужно подправить или заменить ф-цию whatAcadVer

Код:

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

(defun whatAcadVer ( / Aver)
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008 2009
(setq Aver (atof (substr (getvar "ACADVER") 1 4)))
(cond
((= Aver 18.0) 2010)  
((= Aver 17.2) 2009)
((= Aver 17.1) 2008)
((= Aver 17.0) 2007)
((= Aver 16.2) 2006)    
((= Aver 16.1) 2005)
((= Aver 16.0) 2004)
((= Aver 15.06) 2002)
(t 2011)
)
)

Писалась, когда еще не было 2009
PS. Обновил пост #3, исправить в #1 нужно просить Profan'a

[acyxou]

Ну я так и понял... спасибо огромное.
Меня вообще-то вот что интересует: раскладываю, например, 3 вида арматурных сеток, отличающихся по ширине, каждая в своем слое ("с1", "с2" и "с3" соответственно). Далее нужно составить спецификацию. Конечно удобно считать с найденным мною недавно лиспом под названием "entlen", но будучи еще более ленивым, хотелось бы упростить себе и эту задачу, а именно, сделать так, чтоб в ячейке таблицы спецификации, соответствующей конкретной сетке (с1, например), автоматом считалась длина всех полилиний, обозначающих данную сетку, т.е. сумма всех полилиний в слое "с1". И далее при изменении длин полилиний (сеток), поле бы обновлялось соответственно. Возможно ли такое сотворить при помощи данного лиспа?
Заранее спасибо.

[VVA]

acyxou, Посмотри здесь: Связь графических объектов и текста Вышеизложенные команды вышли из этой темы.
Полями сделать нельзя. Можно сделать реакторами, но не по слоям и не в таблицу, а в текст. В таблицу можно вставить поле со ссылкой на данный текст.

[acyxou]

Сообщение от VVA acyxou, Посмотри здесь: Связь графических объектов и текста Вышеизложенные команды вышли из этой темы. Полями сделать нельзя. Можно сделать реакторами, но не по слоям и не в таблицу, а в текст. В таблицу можно вставить поле со ссылкой на данный текст.

Большое спасибо! То, что нужно!!!

[Павлов Андрей]

Здравствуйте . У меня вопрос : можно ли каким-то образом вставлять поля с объемом и массой для 3D solid ?

[Largo GT]

Отличный форум! Жаль, что раньше сюда не заходил, столько времени потерял
Ребята помогите с задачкой, я в LISPe новичок, а вам разминка.
Классная команда PTLB, а если ее немного переделать , суть задачки в следующем :
- есть замкнутая полилиния, нужно вставить в указанную точку рисунка или в существующий текст с заменой, текст с полем (FIELD), содержащий значение площади этого контура. При этом в установках можно выбирать шрифт вводимого нового текста, с выбором разделительного знака( . или ,) по принципу z-calc-text-value.

думаю многим, особенно архитекторам, это очень поможет, заранее спасибо.
я работаю в ACAD2007rus

[LAmyk]

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