[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 и т.д.

[Redya]

VVA, использую ваш лисп AREATT #2, всё замечательно. Единственное: он вставляет значение в милиметрах квадратных,а надобно в метрах кв. Приходиться кликать на каждоую ячейку со значение, и менять в поле коэффициент пересчета на 0.000001, а это очень много занимает времени. Как быть? Одним махом я так и не смог поменять коэффициент пересчета во всех нужных полях.

[VVA]

Сообщение от Redya Как быть?

Внимательно смотреть в командную строчку

Команда: areatt Текущий масштаб = 1 Текущая точность округления = 2 Высота текста = 1.5 Префикс= Суффикс= Перемещаться [по стРокам/по сТолбцам/Установки] <по сТолбцам>: У Новый масштабный коэффициент <1> : 0.000001 Точность округления <2> : 3 Высота текста <1.5> : Префикс (пробел - очистить) <> : Суффикс (пробел - очистить) <> : Перемещаться [по стРокам/по сТолбцам/Установки] <по сТолбцам>: Укажите ячейку таблицы: Выберите примитив для вставки его площади в таблицу (ENTER — завершение): Выберите примитив для вставки его площади в таблицу (ENTER — завершение):

Чтобы задать по умолчанию метры квадратные найди в тексте строчку

Код:

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

  (or *SCALE* (setq *SCALE* 1))

Замени на

Код:

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

  (or *SCALE* (setq *SCALE* 0.000001))

[Redya]

Offtop: VVA, я идиот, спасибо!

[Archeo]

VVA, спасибо! Всё работает, просто супер!
Вот только жаль, оффсета нету Ну и ладно, значит, не судьба. Главное - работает.

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

Здравствуйте .
VVA , подскажите пожалуйста , а можно ли сделать так , чтобы - указал как перемещаться , например по столбцам , ткнул в ячейку таблицы , а примитивы указывать не по одному , а рамкой ?

[VVA]

Сообщение от Павлов Андрей можно ли сделать так , чтобы - указал как перемещаться , например по столбцам , ткнул в ячейку таблицы , а примитивы указывать не по одному , а рамкой ?

Можно

Код:

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

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

(defun C:MAREATT ( / en obj tblobj row col lst pt rows cols what fld ss)
  (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*)
  (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)
               (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))
    (princ "\nВыберите примитивы для вставки их площади в таблицу (ENTER — завершение): ")
    (setq ss (ssget))
    (while (and ss (> (sslength ss) 0) (setq en (ssname ss 0)))
      (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!"))
      )
     (ssdel (ssname ss 0) ss)
    )
   )
   (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)
     )
  )
)

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

VVA .
Спасибо огромное !!!!!
Только вопрос : сортирует по времени отрисовки ?

[VVA]

Сообщение от Павлов Андрей Только вопрос : сортирует по времени отрисовки ?

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

Здравствуйте .

Сообщение от VVA сортирует по времени отрисовки ?

Т.е. я хотел сказать по времени создания примитива ?

[Shaft]

Здравствуйте!
А возможно добавить следующее:

Иногда необходимо занести в ячейку таблицы сумму 2-х и более площадей. Не прерывая при этом дальнейшее выполнение программы.

пример:
-Запустил areatt и начал поочередно указывать интересующие меня объекты.

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

-Нажимаю (НАПРИМЕР) букву S (summa) программа переходит в режим суммирования. Нажимаю ENTER и результат вставляется в ячейку.

Зы. Так же добавить возможность вычитания по аналогии.

ЗЗы. Спасибо большое за вашу программу. Позволяет, ощутимо, снизить кол-во рутинной работы!

[VVA]

Shaft, Обновил #2

[Shaft]

Уважаемы VVA, Вы ГЕНИЙ! Безмерно Вам благодарен за помощь, которую Вы оказываете!!!
Это то, чего мне так не хватало! Теперь хватает!

[skkkk]

1. У меня в таблице, состоящей из всего одной ячейки, поле, ссылающееся на длину некоей линии. Если я копирую ячейку и линию вместе, то поле новой ячейки - что логично - ссылается на первую линию, а не на новую. Можно ли каким-то образом (блок, группа или еще что-то) эту пару объектов размножать так, чтобы каждая новая ячейка ссылалась на "свою" линию?
2. Аналогично, в такой вот ячейке стоит поле - ссылка на ширину этой же ячейки. Если копирую ее, поле новой ссылается на ширину старой. Поправимо?
Была мысль делать это блоком, затем вставлять блок и сразу взрывать его. Так не выходит. Тупик?

[Лиспер]

skkkk, вопрос: а если вместе с таблицей копируется несколько отрезков? Как программно определить, к какой копии должно относиться поле?

[Pavel23]

Всем привет. Классные лиспы надыбал в этой теме, очень удобно и актуально, всем разработчикам "Респект и уважуха". Коллеги, а никто не думал о том, что иногда нужно вставить поле в атрибут блока? У меня сейчас, как раз такая проблема. Есть готовый блок вставленный в чертеж, хорошо бы, чтобы лисп, который вставляет поля с длиной и площадью в таблицы и просто в поле чертежа, мог бы и в атрибут поле засунуть... Ни кто, не поможет с этой задачей?

[VVA]

Сообщение от Pavel23 Коллеги, а никто не думал о том, что иногда нужно вставить поле в атрибут блока?

Посмотри здесь Area Field to Attribute

Program Description This program allows a user to populate a selected attribute with a Field referencing the area, or sum of areas, of one or more objects. The user is prompted to make a selection of objects for which to retrieve the area, if more than one object is selected the cumulative area for all objects will be displayed in the resultant Field. Following object selection, the user is prompted to select an attribute to house the Field string. The Field will display the sum of the areas of the selected objects, formatted in the current units and precision of the drawing.

[Pavel23]

Огромное спасибо VVA! Протестил лисп, работает пока нормально, без траблов. Правда изначально программа вставляла поле с площадью, немного докрутил, теперь вставляет то, что надо, поле длины. Это большое подспорье, извлекаю кабельный журнал из блоков в которых прописывается кабло, поле длины раньше вставлял ручками, ну теперь ваще, прям цельный САПР...

[Горян]

Доброго времени суток! Полезные программы! Спасибо! VVA один вопрос в #2 при выборе суммирования/вычитания не понимает масштабный коэффициент, выводит в мм2, в силу своей LISP-неграмотности сам исправить вряд ли смогу... Если не затруднит, поправьте пожалуйста... Очень уж пригодилась программа, а циферки лишние глаз корябают.
Область применения, если интересно: раскрой листового материала, много разноразмерных деталей сложной конфигурации, а отчеты формировать ручками приходится, правда не мне, а сотрудникам, но все равно мартышкин труд. Заранее благодарен.

[skkkk]

Сообщение от Лиспер skkkk, вопрос: а если вместе с таблицей копируется несколько отрезков? Как программно определить, к какой копии должно относиться поле?

Лиспер, условие моей задачи подразумевает одну линию, две мне попросту ни к чему
Я таки решил свою задачку с #73, обнаружив интересную закономерность (особенность) AutoCADa: Если блок вставить, а затем расчленить, то поле слетает, а если его вставить сразу с опцией Расчленить, то выходит, что можно

Сообщение от skkkk эту пару объектов размножать так, чтобы каждая новая ячейка ссылалась на "свою" линию

Опция Расчленить вызывается установкой соответствующей галочки в окне Вставка блока (интерактивный режим, команда _insert), либо в прозрачном режиме (команда _-insert) на запрос опции имени блока вставкой звездочки (*) перед именем. Только остался вопрос к программистам: в лиспе, в конструкции

Код:

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

(command "_-insert" "*name"............)

звездочка не действует. Как быть?

[VVA]

skkkk, Только что проверил, действует.
Создай блок с именем "BLK". Код ниже вставит его расчлененным в точку 100,100

Код:

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

(command "_-insert" "*Blk" "100,100" 1 1 0)

>Pavel23 Проверю, но позже. Сейчас катастрофически не хватает времени