dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

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

LISP. Вставка в таблицу поля, соотвествующего площади примитива

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 28.10.2007, 06:13 #1
LISP. Вставка в таблицу поля, соотвествующего площади примитива
Profan
 
Чужой
 
Москва
Регистрация: 25.12.2005
Сообщений: 13,666

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

Последний раз редактировалось Кулик Алексей aka kpblc, 11.08.2009 в 22:23.
Просмотров: 100181
 
Непрочитано 29.10.2007, 10:19
#2
VVA

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


Цитата:
;;;; Команда: 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, 31.08.2012 в 22:34. Причина: Обновлен вариант с суммированием (разделитель дробной части)
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.11.2007, 20:07
#3
VVA

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


Вариант команды 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)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 17.10.2014 в 13:26. Причина: Добавилась новая настройка - округление
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 11.05.2008, 22:28
#4
gabrin

Инновации в проектировании
 
Регистрация: 13.02.2007
Россия
Сообщений: 106
Отправить сообщение для gabrin с помощью ICQ Отправить сообщение для gabrin с помощью Skype™


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

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


Полилинии какие: 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)
  )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.05.2008, 11:48
#6
gabrin

Инновации в проектировании
 
Регистрация: 13.02.2007
Россия
Сообщений: 106
Отправить сообщение для gabrin с помощью ICQ Отправить сообщение для gabrin с помощью Skype™


В моем случае я использую 3DPolyline
gabrin вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.05.2008, 11:55
#7
gabrin

Инновации в проектировании
 
Регистрация: 13.02.2007
Россия
Сообщений: 106
Отправить сообщение для gabrin с помощью ICQ Отправить сообщение для gabrin с помощью Skype™


Хороший Лисп, как раз то что нужно. Последний вопрос- Как сделать чтобы все это выводилось в одну таблицу на экран?
gabrin вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.05.2008, 12:36
#8
VVA

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


Цитата:
Сообщение от gabrin Посмотреть сообщение
В моем случае я использую 3DPolyline
У 3d полилинии нет свойства "Уровень", соответственно полем на координату Z не сослаться
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.05.2008, 13:02
#9
gabrin

Инновации в проектировании
 
Регистрация: 13.02.2007
Россия
Сообщений: 106
Отправить сообщение для gabrin с помощью ICQ Отправить сообщение для gabrin с помощью Skype™


Цитата:
Сообщение от VVA Посмотреть сообщение
У 3d полилинии нет свойства "Уровень", соответственно полем на координату Z не сослаться
Дело в том что я пользуюсь Лиспом прокладки 3DPolyline на разных отметках с опусками и подъемами. С уровнем я уже понял. Возможно переделать ваш Лисп под 3DPolyline?
gabrin вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.05.2008, 15:50
#10
VVA

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


Остальные (кроме Уровня) свойства есть у любых полилиний. Поэтому без разницы 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)
  )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 11.07.2008, 14:46
#11
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 107


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... чет не работает. что первый что второй вариант.
Что вообще этот лисп делает?
DonJad вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 11.07.2008, 15:15
#12
VVA

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


DonJad, Сами команды опубликованы в #1,2,3 (различные варианты)
Лисп работает правильно. Он печатает тебе значения полей указанной полилинии. Если скопировать в буфер тест %< ... >% и вставить в рекакторе текста, то получись поле со ссылкой на соотв. свойство (длину, стлой или тип линии)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2008, 07:58
#13
acyxou


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


Уважаемый VVA, как сделать так чтоб лисп в 2009-ом Автокаде работал?
Заранее спасибо за ответ.
acyxou вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 25.08.2008, 13:30
#14
VVA

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


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
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 07.06.2010 в 20:02.
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 26.08.2008, 09:18
#15
acyxou


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


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

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


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

Последний раз редактировалось VVA, 19.03.2015 в 21:39. Причина: уточнена ссылка
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 26.08.2008, 17:05
#17
acyxou


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


Цитата:
Сообщение от VVA Посмотреть сообщение
acyxou, Посмотри здесь: Связь графических объектов и текста Вышеизложенные команды вышли из этой темы.
Полями сделать нельзя. Можно сделать реакторами, но не по слоям и не в таблицу, а в текст. В таблицу можно вставить поле со ссылкой на данный текст.
Большое спасибо! То, что нужно!!!
acyxou вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 22.11.2008, 16:54
#18
Павлов Андрей

Инженер-строитель
 
Регистрация: 27.05.2004
Республика Беларусь
Сообщений: 62


Здравствуйте . У меня вопрос : можно ли каким-то образом вставлять поля с объемом и массой для 3D solid ?
__________________
Andrey
Павлов Андрей вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.03.2009, 00:20
#19
Largo GT

Архитектор
 
Регистрация: 11.03.2009
Новороссийск
Сообщений: 97


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

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

Последний раз редактировалось Largo GT, 13.03.2009 в 14:27.
Largo GT вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 01.04.2009, 17:38
#20
LAmyk


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


помогите пожалуйста с лиспом
нужно поле значения текста вставлять на место другого текста.
примерно так
выбор исходного текста
выбор текста который будет заменен полем
LAmyk вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Вставка в таблицу поля, соотвествующего площади примитива

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

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

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP на измерение площади Малюк LISP 2 27.09.2007 14:51
vb6 вставка таблицы AutoCad'a в таблицу Word'a HiddenM Программирование 1 11.01.2007 16:11

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||