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

[Ahntv]

Добрый день!
Подскажите пожалуйста!!

Произвожу подсчет площади полилиний в AutoCAD 2013 , с помощью ПОЛЕ.
Затем другие сотрудники открывают этот чертеж в BricsCAD V13 (x64),
бывает происходит такая вещь: все значения ПОЛЯ превращаются в нули.
В чем может быть причина?
Подскажите пожалуйста!
Заранее Вам благодарен

[Кулик Алексей aka kpblc]

Сообщение от Ahntv В чем может быть причина?

Например, в BricsCAD'e: ему знакомо понятие поля?

[Ahntv]

Добрый день, Алексей!
Да там есть ПОЛЕ, но там не такой функционал, как в AutoCADе.

[Ahntv]

Добрый день!
Подскажите пожалуйста!
Можно ли пожалуйста сделать LISP - Arreat , на подобии LISPa - DIMTLB?
Чем он удобен:
Просто выделяешь объект с площадью и сразу вставляешь его в таблицу, с точностью - текущая точность.
Не нужно производить настройки, дополнительные операции.
Заранее вам благодарен.

[VVA]

Ahntv, Можно. Найди строчку

Код:

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

(or *PREC* (setq *PREC* 2))

и вместо цифры 2 поставь нужную, а для текущей точности замени на строчку

Код:

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

(or *PREC* (setq *PREC* (getvar "LUPREC")))

[Ahntv]

Да
Но там вопрос в другом!
Нужно так:
Нажал на кнопку -> выбрал полилинию -> указал ячейку в таблице и все.

[VVA]

Ahntv, PTLB из #3 Там в описании есть все опции для кнопки. Т.е на кнопку вешается не вызов PTLB

^C^C(if (not C:PTLB) (load "ptlb"));PTLB;

а что-то типа

^C^C(if (not C:PTLB) (load "ptlb"));PTLB;_L;_S;1;0.001;2;3;5;;м2;

[antoniospb]

Уважаемые форумчами, просьба помочь, кто разбирается в программировании LSP

Как можно дороботать PTLB.lsp из поста #33 http://forum.dwg.ru/showpost.php?p=395293&postcount=33
Задача: необходимо выбирать на чертеже полилинию, и далее, значение её длины вставлять не в ячейку таблицы, а вставлять в атрибут блока с названием "ДЛИНА" указанного следом блока. При изменении длины полилинии, необходимо что бы поле в атрибуте блока автоматически обновлялось. Т.е. необходимо создать связь между длиной полилинии и атрибутом блока, которая будет обновляться автоматически в зависимости от изменения длины полилинии.

Всем кто окажет помощь заранее огромная благодарность за содействие.

Сам не разбираюсь в программировании LSP, но такой lsp очень нужен!!!

[Boxa]

Сообщение от antoniospb Сам не разбираюсь в программировании LSP, но такой lsp очень нужен!!!

Может сюда написать http://forum.dwg.ru/forumdisplay.php?f=33 , быстрее получите решение.

ЗЫ.
Я в lisp вообще ничего не понимаю, но если мне нужен молоток, то я иду в магазин.

[Сергей812]

Offtop: Автоматическая связанная обработка.. привязка полилинии к блоку, изменений атрибута блока, реактор на изменение полилиний - достойная задача, чтобы начать изучать лисп

[Ahntv]

Добрый день уважаемые форумчане!
Подскажите пожалуйста!

C помощью LISPов DIMTLB и AREATT заносил площадь контуров поллиний в таблицу (ПОЛЕ, FIELD).
Через некоторое время заметил, что исчезли занесенные значения.

Подскажите пожалуйста в чем может быть причина, и как устранить!
Заранее Вам благодарен!

[Largo GT]

Сообщение от Ahntv C помощью LISPов DIMTLB и AREATT заносил площадь контуров поллиний в таблицу (ПОЛЕ, FIELD). Через некоторое время заметил, что исчезли занесенные значения. Подскажите пожалуйста в чем может быть причина, и как устранить!

Первое что приходит в голову: значения исчезли а вместо них ###, значит удалил контуры. А слои не отключал ?

[Ahntv]

Largo GT

Контуры не удалялись!
Получается работал в AutoCAD, а кто то открыл чертеж в BricsCAD и они слетели, просто на их месте пустота.
Вот начал искать, в Настройка -> Пользовательские -> Обновление полей снял галочки для автоматического обновления полей при открытии , сохранении , печати, оставил только при регенерации.
Посмотрим может все дело в разных программах???

[Кулик Алексей aka kpblc]

Сообщение от Ahntv Посмотрим может все дело в разных программах???

А что, BricsCAD поддерживает поля?
Добавлено: v13 вроде бы поддерживает, но я не уверен, что там настройки "нормальные"...

----- добавлено через ~7 мин. -----
"Там" - имею в виду в BricsCAD. Можно же, наверное, так выставить опции, что поля будут пониматься как прокси-объекты и впоследствии удаляться.

[Largo GT]

Offtop: Ты молодец! А раньше рассказать ?

Сообщение от Ahntv работал в AutoCAD, а кто то открыл чертеж в BricsCAD и они слетели, просто на их месте пустота.

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

[Ahntv]

Спасибо за ответ!

А не подскажите по поводу "что поля будут пониматься как прокси-объекты и впоследствии удаляться"

как это сделать в BricsCAD?

[Кулик Алексей aka kpblc]

Я не уверен в такой возможности - поэтому и сказал

Сообщение от Кулик Алексей aka kpblc наверное, так выставить опции, что поля будут пониматься как прокси-объекты и впоследствии удаляться

Например, demandload поставить в 1 или в 0, и proxyshow в 0. Это предположения - может быть, спецы по BricsCAD скажут более подробно.

[betonolom]

Добра всем!
Пробовал этот лисп применить на 64-й системе, Autocad 2011 и Autocad 2013, но после того как указал нужный примитив или отрисовал его, тут же автокад выдает:
Фатальная ошибка: Unhandled access violation reading 0x0032 Exception at e7016bcdh
Подскажите пожалуйста как лечить.

Код:

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

 ; Команда: 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)
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008 2009
(setq Aver (atof (substr (getvar "ACADVER") 1 4)))
(cond
((= Aver 20.0) 2015)
((= Aver 19.1) 2014)
((= Aver 19.0) 2013)
((= 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)
)
)
(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)
)

и этот лисп тоже http://www.caduser.ru/forum/index.ph...#message262138

[skkkk]

betonolom, здесь ответ.

[Ahntv]

Добрый день dwg.ru форумчане.
Подскажите пожалуйста.
В лиспе есть функция по столбцам и по строкам,
можно ли сделать чтобы при выборе перескакивало через одну ячейку в таблице.