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

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

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

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

Оригинал темы находился на форуме 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.
Просмотров: 136384
 
Непрочитано 29.10.2007, 10:19
#2
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,788
<phrase 1= Отправить сообщение для 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,788
<phrase 1= Отправить сообщение для 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
<phrase 1= Отправить сообщение для gabrin с помощью Skype™


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,788
<phrase 1= Отправить сообщение для 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
<phrase 1= Отправить сообщение для gabrin с помощью Skype™


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

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


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

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


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

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


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

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,788
<phrase 1= Отправить сообщение для 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,788
<phrase 1= Отправить сообщение для 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,788
<phrase 1= Отправить сообщение для 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,788
<phrase 1= Отправить сообщение для 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
Новороссийск
Сообщений: 99


Отличный форум! Жаль, что раньше сюда не заходил, столько времени потерял
Ребята помогите с задачкой, я в 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
Сообщений: 34


помогите пожалуйста с лиспом
нужно поле значения текста вставлять на место другого текста.
примерно так
выбор исходного текста
выбор текста который будет заменен полем
LAmyk вне форума  
 
Непрочитано 01.04.2009, 17:53
#21
VVA

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


LAmyk,
Код:
[Выделить все]
(defun C:TEST ()
(vl-load-com)
(while (and
	 (princ "\nВыберите текст - источник: ")
	 (setq ss (ssget "_:S:E" '((0 . "TEXT"))))
	 (setq t1 (ssname ss 0))
	 (setq t1 (vlax-ename->vla-object t1))
	 (setq fld (vla-FieldCode t1))
	 (princ "\nВыберите текст - приемник: ")
	 (setq ss nil ss (ssget "_:S:E:L" '((0 . "TEXT"))))
	 (setq t2 (ssname ss 0))
	 )
  	 (vla-put-TextString (vlax-ename->vla-object t2) fld)
	 (entupd t2)
  )
  (princ)
  )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 01.04.2009, 23:24
#22
LAmyk


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



этот лисп переносит из источника в применик содержимое как я понял.
а хотел бы чтобы в приемник переносился обьект
тоесть чтобы если потом в источние меняется значние, оно менялось бы и в приемнике
LAmyk вне форума  
 
Непрочитано 01.04.2009, 23:33
#23
Largo GT

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


>LAmyk
попробуй здесь http://www.kitox.com/kitoxtools/helptools_ru.php
команда: Меняет текст по эталону, скачать можно бесплатно здесь http://www.kitox.com/kitoxtools_ru.php
Largo GT вне форума  
 
Непрочитано 02.04.2009, 15:13
#24
VVA

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


Тогда так
Код:
[Выделить все]
(defun C:TEST ()
(vl-load-com)
(while (and
	 (princ "\nВыберите текст - источник: ")
	 (setq ss (ssget "_:S:E" '((0 . "*TEXT"))))
	 (setq t1 (ssname ss 0))
	 (setq t1 (vlax-ename->vla-object t1))
	 (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid t1)
                  ) ;_ vl-princ-to-string
                ">%).TextString>%"
                ) ;_ strcat
          ) ;_ setq
	 ;;(setq fld (vla-FieldCode t1))
	 (princ "\nВыберите текст - приемник: ")
	 (setq ss nil ss (ssget "_:S:E:L" '((0 . "*TEXT"))))
	 (setq t2 (ssname ss 0))
	 )
  	 (vla-put-TextString (vlax-ename->vla-object t2) fld)
         (command "_draworder" (vlax-vla-object->ename t1) "" "_U"  "" t2 "")
	 (entupd t2)
         
  )
  (princ)
  )
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 05.04.2009 в 20:04. Причина: См #28
VVA вне форума  
 
Непрочитано 02.04.2009, 18:21
#25
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,338
<phrase 1=


Можно я свои 5 копеек вставлю.
А может не мучится и предаствить пользователю самому выбирать что вставить из свойств объекта???
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 02.04.2009, 21:38
#26
LAmyk


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Тогда так
Код:
[Выделить все]
(defun C:TEST ()
спасибо, все работает.
Только вот с мтекстом не дружит(((

Последний раз редактировалось LAmyk, 02.04.2009 в 21:52.
LAmyk вне форума  
 
Непрочитано 03.04.2009, 10:39
#27
VVA

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


Цитата:
Сообщение от LAmyk Посмотреть сообщение
Только вот с мтекстом не дружит(((
Добавил обработку MTEXT'a. Изменил #24. Изменения выделил красным
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 05.04.2009, 15:41
#28
LAmyk


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Добавил обработку MTEXT'a. Изменил #24. Изменения выделил красным
после первого прохода от источника к риемнику
начинает подглючивать:


Команда: test
Выберите текст - источник:
Выберите объекты:
Выберите текст - приемник:
Выберите объекты:
_draworder
Выберите объекты: найдено: 1
Выберите объекты: _U
Выберите объекты:
Команда: <имя объекта: 7D837550>
Команда: TEST Неизвестная команда "TEST". Для вызова справки нажмите F1.
Команда:
Выберите текст - источник:
Выберите объекты:
Выберите текст - приемник:
Выберите объекты:
_draworder
Выберите объекты: найдено: 1
Выберите объекты: _U
Выберите объекты:
Команда: <имя объекта: 7D837540>
Команда: ; ошибка: Функция отменена
LAmyk вне форума  
 
Непрочитано 05.04.2009, 20:05
#29
VVA

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


Исправил #24
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 09.04.2009, 09:35
#30
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,338
<phrase 1=


VVA, повторю еще раз свою мысль:
может не мучится и предоставить пользователю самому выбирать, что вставить из свойств объекта???
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 09.04.2009, 12:52
#31
VVA

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


zenon, У разных объектов разные свойства, не все свойства отображаются полями.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.04.2009, 12:31
#32
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,338
<phrase 1=


Цитата:
Сообщение от VVA Посмотреть сообщение
zenon, У разных объектов разные свойства, не все свойства отображаются полями.
мысль такая, через поле "Object" указываешь объект, и выбираешь. Нужно избавиться от промежуточных операция.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 13.05.2009, 22:08
#33
Largo GT

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


Цитата:
Сообщение от VVA Посмотреть сообщение
Вариант команды PAREATLB вставляет в таблицу тест с длиной примитива или площадью
Код:
[Выделить все]
;  Команда: PTLB
;  Эта команда позволяет вставить в указанную точку рисунка или указанную ячейку таблицы
;  текст с полем (FIELD), содержащее значение площади или длины построенного или выбранного контура.
;  Точность округления и масштабный коэффициент настраиваются через опцию Установки
;  Так как это поле связано с конкретным объектом, то при изменении
;  объекта поле пересчитывается (необходимо обновление поля)
;  Код можно сохранить в файле ptlb.lsp
;  Возможный макрос для кнопки или пункта меню:
;  ^C^C(if (not C:PTLB) (load "ptlb"));PTLB;
;; Вариант макроса для задания м2
;; ^C^C(if (not C:PTLB) (load "ptlb"));PTLB;_L;_S;1;0.001;2;5;;м2;
;;Где
;; _L - считать длинну (_A - площадь)
;; _S - установки
;; 1 - линейный масштабный коэффициент
;; 0.001 — площадной масштабный коэффициент
;; 2 — точность округления
;; 5 — высота текста
;; префикса нет
;; м2 - суффикс
(defun C:PTLB ( / en cmdname fld txt fc tblset tblobj row col pt
                 whatAcadVer tstyle what)
;;;Ф-ция возвращает версию Автокада ввиде 2004 2005 2006 2007 2008 2009
(defun whatAcadVer ( / Aver)
(setq Aver (atof (substr (getvar "ACADVER") 1 4)))
(cond
((= 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 0)
)
)  (vl-load-com)
  (or *SCALEL* (setq *SCALEL* 1))
  (or *SCALEA* (setq *SCALEA* 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*))
  (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 *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 "\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" (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(vla-get-objectid (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
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Circumference \\f \"%lu2%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEL*)"]\">%"
                ) ;_ strcat
          ) ;_ setq
     )
    ((and (= what "Length")
          (= (cdr(assoc 0 (entget en))) "ARC")
          )
     (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).ArcLength \\f \"%lu2%pr"(itoa *PREC*) "%ct8["(vl-princ-to-string *SCALEL*)"]\">%"
                ) ;_ 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
                  (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
     )
    (t (setq fld "Неизвестное свойство"))
    )
(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" '((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)
  )
Пользуюсь командой PTLB - очень нравится я втянулся и теперь возникла потребность в преобразовании текста с полем (FIELD), содержащее значение площади в обычный текст.
Может не совсем понятно выражаюсь, поясню:
На планах этажей считал площади помещений, с помощью команды КОНТУР обводил полилинией помещения и командой PTLB проставлял площади. Теперь планы нужно передавать заказчику и не только ему одному, я хотел почистить планы: удалил контуры помещений (так сказать чтоб врагу не досталось) да только тексты с полями (FIELD) превращаются в #### после РЕГЕНа, а взорвать их не получается
подскажите пожалуйста как добиться желаемого ???
Largo GT вне форума  
 
Непрочитано 14.05.2009, 11:12
#34
VVA

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


Largo GT, Как все поля чертежа сразу преобразовать в текст?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.06.2009, 20:45
#35
Positron


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


Помогите плиз кто разбирается, а можно ли пероброзовать етот лисп под другую цель, есть необходимость штоб не обекты, тоисть не площадь щитывала, а размеры щитывала в таблицу и при етом в 1ну клетку кидало 3 поля по очереди, типа "125х290х500" ...

Тось напимер нарисовал 1 раз шкаф с размерами и зделал спецыфикацыю с полями ... а потом еси надо просто потянул шаф с размерами и в спецыфикации обновились размеры...
Positron вне форума  
 
Непрочитано 30.06.2009, 12:45
#36
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


>Positron
Полное издевательство над русским языком...
CB вне форума  
 
Непрочитано 30.06.2009, 12:54
#37
zenon

Остекляем!!! Алюминим!!!
 
Регистрация: 21.02.2005
Москва
Сообщений: 3,338
<phrase 1=


Цитата:
Сообщение от Positron Посмотреть сообщение
Помогите плиз кто разбирается, а можно ли пероброзовать етот лисп под другую цель, есть необходимость штоб не обекты, тоисть не площадь щитывала, а размеры щитывала в таблицу и при етом в 1ну клетку кидало 3 поля по очереди, типа "125х290х500" ...

Тось напимер нарисовал 1 раз шкаф с размерами и зделал спецыфикацыю с полями ... а потом еси надо просто потянул шаф с размерами и в спецыфикации обновились размеры...
все это можно 1 раз нарисовать а затем как шаблон использовать.
__________________
Мы можем делать быстро, качественно и недорого, выбирайте любые 2 условия.:search:
zenon вне форума  
 
Непрочитано 27.07.2009, 16:02
#38
Positron


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


Извините за русский ...
Но вопрос не в том что можно сделать шаблон, суть в быстром методе создавания полей с привязками к размерам...
А у меня специфика работы в том што часто надо новые создавать вещи ...
а если б кто помог кто луче "шарит" в лиспах начать эту тему то существенно помог..
Заранее спасибо огромное доброму человеку!
Positron вне форума  
 
Непрочитано 27.07.2009, 16:34
#39
VVA

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


Positron, Выложи пример шкафа и таблицы с полями (dwg файл).
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 11.08.2009, 13:21
#40
Positron


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Positron, Выложи пример шкафа и таблицы с полями (dwg файл).
Извиняюсь шо с таким запозданием... лето, отпуска
вот пример, зелёным цветом выделил поле с привязкой к размеру...
Суть в том што часто приходится менять габариты и после, вписывать в таблицу снова...
А имея упрощонную возможность делать поле с привязкой к размеру поможет существенно, я думаю не только в подобной областе такая штука пригодится
Вложения
Тип файла: dwg
DWG 2007
Пример.dwg (247.8 Кб, 4116 просмотров)
Positron вне форума  
 
Непрочитано 11.08.2009, 21:48
#41
VVA

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


Positron,
Код:
[Выделить все]
(defun C:BOXTLB ( / cmdname fld txt tblset tblobj row col dimtxt
                 whatAcadVer tstyle what
                 ss dim1 dim2 dim3)
(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)
)
)
  (vl-load-com)
 (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (and
    (or ;_ > Проверяем версию
      (> (whatAcadVer) 2005)
      (alert "\nНужен Автокад версии 2006 и выше")
      ) ;_ < Проверяем версию
    (princ "\nВыберите 1-й размер")
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim1 (vlax-ename->vla-object(ssname ss 0)))
     (setq dimtxt (strcat (vl-princ-to-string(vla-get-measurement dim1)) " x"))
    (or (vla-Highlight dim1 :vlax-true) t)
    (princ "\nВыберите 2-й размер : ")(princ dimtxt)
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim2 (vlax-ename->vla-object(ssname ss 0)))
    (or (vla-Highlight dim2 :vlax-true) t)
    (setq dimtxt (strcat dimtxt (vl-princ-to-string(vla-get-measurement dim2)) " x"))
    (princ "\nВыберите 3-й размер : ")(princ dimtxt)
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim3 (vlax-ename->vla-object(ssname ss 0)))
    (or (vla-Highlight dim3 :vlax-true) t)
    (princ (setq dimtxt (strcat dimtxt " " (vl-princ-to-string(vla-get-measurement dim3)))))
  ;_ Формируем поле
  ;;;  %<\AcObjProp Object(%<\_ObjId 2130564848>%).Measurement \f "%lu2%pr0">%
    (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 dim1))
                ">%).Measurement \\f \"%lu2%pr0\">%"
                "x"
                "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 dim2))
                ">%).Measurement \\f \"%lu2%pr0\">%"
                "x"
               "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 dim3))
               ">%).Measurement \\f \"%lu2%pr0\">%"
                ) ;_ strcat
          ) ;_ setq
  (or (vla-Highlight dim1 :vlax-false)
      (vla-Highlight dim2 :vlax-false)
      (vla-Highlight dim3 :vlax-false)
   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 Укажите точку вставки текста или ячейку таблицы(")(princ dimtxt)(princ ") :")
  (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)
  )
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 17.10.2014 в 13:27. Причина: Добавлен Get-ObjectID-x86-x64
VVA вне форума  
 
Непрочитано 13.08.2009, 14:42
#42
Positron


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Positron,
Код:
[Выделить все]
(defun C:DIMTLB ( / cmdname fld txt tblset tblobj row col dimtxt
                 whatAcadVer tstyle what
                 ss dim1 dim2 dim3)
(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 0)
)
)
  (vl-load-com)
 (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (and
    (or ;_ > Проверяем версию
      (> (whatAcadVer) 2005)
      (alert "\nНужен Автокад версии 2006 и выше")
      ) ;_ < Проверяем версию
    (princ "\nВыберите 1-й размер")
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim1 (vlax-ename->vla-object(ssname ss 0)))
     (setq dimtxt (strcat (vl-princ-to-string(vla-get-measurement dim1)) " x"))
    (or (vla-Highlight dim1 :vlax-true) t)
    (princ "\nВыберите 2-й размер : ")(princ dimtxt)
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim2 (vlax-ename->vla-object(ssname ss 0)))
    (or (vla-Highlight dim2 :vlax-true) t)
    (setq dimtxt (strcat dimtxt (vl-princ-to-string(vla-get-measurement dim2)) " x"))
    (princ "\nВыберите 3-й размер : ")(princ dimtxt)
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim3 (vlax-ename->vla-object(ssname ss 0)))
    (or (vla-Highlight dim3 :vlax-true) t)
    (princ (setq dimtxt (strcat dimtxt " " (vl-princ-to-string(vla-get-measurement dim3)))))
  ;_ Формируем поле
  ;;;  %<\AcObjProp Object(%<\_ObjId 2130564848>%).Measurement \f "%lu2%pr0">%
    (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(vla-get-objectid dim1))
                ">%).Measurement \\f \"%lu2%pr0\">%"
                "x"
                "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(vla-get-objectid dim2))
                ">%).Measurement \\f \"%lu2%pr0\">%"
                "x"
               "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(vla-get-objectid dim3))
               ">%).Measurement \\f \"%lu2%pr0\">%"
                ) ;_ strcat
          ) ;_ setq
  (or (vla-Highlight dim1 :vlax-false)
      (vla-Highlight dim2 :vlax-false)
      (vla-Highlight dim3 :vlax-false)
   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 Укажите точку вставки текста или ячейку таблицы(")(princ dimtxt)(princ ") :")
  (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)
  )
Всё работает даже лучше чем я себе представлял эту команду, истиный мастер
ОГРОМНОЕ СПАСИБО!!!
Positron вне форума  
 
Непрочитано 09.09.2009, 17:21
#43
I`ch

архитектура
 
Регистрация: 09.09.2009
минск
Сообщений: 1


вопрос таков, как совместить #2 и #3. точнее заставить код из третьего сообщения автоматически продолжать вставлять значения прощадей/длин в таблицу?..
цены бы не было примочке этой.. )
/или это только у меня не работает?
лично мне показалось не совсем логичным описание "перемещаться по столбцам/строкам" - с первого раза понять трудно. может лучше сделать "располагать в столбец/строку"?
I`ch вне форума  
 
Непрочитано 16.01.2010, 21:16
#44
Archeo

архитектор
 
Регистрация: 02.04.2006
Беларусь
Сообщений: 287


Вечер добрый. Извиняюсь, что поднимаю старую тему. Где-то я вроде бы видел ЛИСП, который тоже вставляет куда надо текст с полем, соответствующим площади замкнутого контура, но предварительно делает оффсет этого контура на 20 мм внутрь (типа отделка). Рылся в поиске, но безрезультатно. Может, у кого-то есть? В идеале, хотелось бы иметь два варианта ЛИСПа: один - без оффсета (для помещений с существующей отделкой), второй - с оффсетом (для помещений с проектируемой отделкой).
По первому варианту меня почти устраивает ЛИСП от VVA (2007-10-04 10:26:53) с командой PAREATLB, но есть некоторые пожелания:
1. Разделителем целой и дробной части хотелось бы видеть запятую, но без изменения системных настроек AutoCAD или Windows.
2. Хочется, чтобы текст вставлялся в слой, отличный от текущего, с возвратом к текущему.
3. Самое главное: ЛИСП выполняется только в пределах одного пространства? Можно ли сделать так: вошёл в видовой экран, выбрал или построил полилинию, затем вышел из видового экрана, указал ячейку таблицы, расположенной в пространстве листа, и так далее? А то у меня таблицы в листах, а планировка в модели.
Если кто-нибудь сможет помочь, буду благодарен.
Archeo вне форума  
 
Автор темы   Непрочитано 16.01.2010, 21:36
#45
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,663


Вот здесь есть моя программа:
http://www.caduser.ru/forum/index.ph...D=44&TID=19751
Только там площадь выводится на экран и записывается в файл.
Возможно, где-то есть аналогичные программы.
Profan вне форума  
 
Непрочитано 17.01.2010, 15:38
#46
Archeo

архитектор
 
Регистрация: 02.04.2006
Беларусь
Сообщений: 287


Profan, спасибо, но мне всё-таки нужно записывать результаты в пределах текущего файла dwg...
Archeo вне форума  
 
Непрочитано 11.02.2010, 02:09
#47
ilya_sp


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


не знаю, можно ли писать запросы в ветку "готовые программы"...

а можно к Лиспу в #24 добавить такую штуку:

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

короче говоря, переключать вид по очереди то на предыдущий источник, то на предыдущий приемник. Тем самым можно будет избежать кучи перемещений по экрану.
надеюсь, понятно описал...
ilya_sp вне форума  
 
Непрочитано 11.02.2010, 10:14
#48
VVA

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


ilya_sp, Пробуй. Название придумай сам. У меня сегодня с этим тяжело
Код:
[Выделить все]
(defun C:TEST ()
(vl-load-com)
(setvar "EXPERT" 5) ;_Для Supermax - установить обязательно
(setvar "CMDECHO" 0)  
(while (and
         (if (tblsearch "VIEW" "ViewTmpSource")
           (progn
             (command "_.VIEW" "_R" "ViewTmpSource")
             (command)
             t)
           t
           )
     (princ "\nВыберите текст - источник: ")
     (setq ss (ssget "_:S:E" '((0 . "*TEXT"))))
     (setq t1 (ssname ss 0))
     (setq t1 (vlax-ename->vla-object t1))
     (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid t1)
                  ) ;_ vl-princ-to-string
                ">%).TextString>%"
                ) ;_ strcat
          ) ;_ setq
     ;;(setq fld (vla-FieldCode t1))
         (progn (command "_.VIEW" "_Save" "ViewTmpSource")(command) t)
         (if (tblsearch "VIEW" "ViewTmpDest")
           (progn
             (command "_.VIEW" "_R" "ViewTmpDest")
             (command)
             t)
           t
           )
     (princ "\nВыберите текст - приемник: ")
     (setq ss nil ss (ssget "_:S:E:L" '((0 . "*TEXT"))))
     (setq t2 (ssname ss 0))
     )
       (vla-put-TextString (vlax-ename->vla-object t2) fld)
         (progn (command "_.VIEW" "_Save" "ViewTmpDest")(command) t)
         (command "_draworder" (vlax-vla-object->ename t1) "" "_U"  "" t2 "")
     (entupd t2)
         
  )
  (setvar "CMDECHO" 1)
  (princ)
  )
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 22.04.2011 в 10:13.
VVA вне форума  
 
Непрочитано 11.02.2010, 14:47
#49
ilya_sp


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


Отлично! то, что нужно спасибо огромное!!
ilya_sp вне форума  
 
Непрочитано 12.02.2010, 11:16
#50
Archeo

архитектор
 
Регистрация: 02.04.2006
Беларусь
Сообщений: 287


Всем привет. К своему сообщению №44. Точку на запятую я исправил сам; как ни странно, в самом тексте ЛИСП. Со вторым вопросом хуже, ЛИСП-то я всё-таки не знаю... Попробовал сделать макрос
Код:
[Выделить все]
^C^C_.-Layer;_New;AREA;_Color;2;AREA;_Plot;n;AREA;;PAREATLB;_.Change;_Last;;_Properties;_C;ByLayer;_LW;ByLayer;_LT;ByLayer;_Layer;AREA;;TEXTSIZE;2.5;
на кнопку, чтобы выполнялась команда PAREATLB (она у меня в автозагрузке) и текст с полем вставлялся на другой слой, но где-то допустил ошибку. Т. е. слой создаётся, команда выполняется, но изменение свойств не происходит. Да, и почему-то этот текст пишется стилем Standard, а не текущим... Может ли кто-нибудь мне помочь довести это до ума?
Archeo вне форума  
 
Непрочитано 12.02.2010, 12:38
#51
VVA

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


Цитата:
Сообщение от Archeo Посмотреть сообщение
Т. е. слой создаётся, команда выполняется, но изменение свойств не происходит. Да, и почему-то этот текст пишется стилем Standard, а не текущим... Может ли кто-нибудь мне помочь довести это до ума?
Найди в тексте эти строчки
Код:
[Выделить все]
(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
)
Для слоя Area замени ;(cons 8 layer) на
(cons 8 "AREA") Обязательно убери коментарий - символ ; вначале
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 12.02.2010, 16:26
#52
Archeo

архитектор
 
Регистрация: 02.04.2006
Беларусь
Сообщений: 287


VVA, спасибо! Со слоем и текстовым стилем всё получилось. Возник другой вопрос. Поле формируется из однострочного текста, а он не подхватывает из текущего стиля ширину 0.8 и угол наклона 15. К тому же хотелось бы видеть на плане эту надпись подчёркнутой. Можно ли это осуществить, или сделать вместо однострочного многострочный текст?

Последний раз редактировалось Archeo, 12.02.2010 в 16:41. Причина: Снял вопрос о высоте текста
Archeo вне форума  
 
Непрочитано 12.02.2010, 17:46
#53
VVA

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


Замени на это
Код:
[Выделить все]
(setq txt (entmakex
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 72 0) ;_ выравнивание влево
(cons 1 (strcat "%%u" fld))
(cons 7 (getvar "TEXTSTYLE")) ;_Текущий стиль
(cons 8 "AREA") ;_Текущий слой
(cons 10 '(0 0 0))
(cons 11 '(0 0 0))
(cons 51 (cdr(assoc 50 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
(cons 41 (cdr(assoc 41 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
(cons 40 *TEXTSIZE*) ;_Высота текста
) ;_ list
) ;_ entmakex
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 12.02.2010, 22:31
#54
Archeo

архитектор
 
Регистрация: 02.04.2006
Беларусь
Сообщений: 287


Спасибо, почти всё работает. За исключением одного момента: когда прицеливаешься и выбираешь точку вставки, то текст с полем отображается подчёркнутым, а после вставки подчёркивание пропадает... Шо бы это значило? Сейчас у меня текст кода такой:
Код:
[Выделить все]
;  Команда: 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*
                "]%ds44%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 (strcat "%%u" fld))
        (cons 7 (getvar "TEXTSTYLE")) ;_Текущий стиль
        (cons 8 "AREA") ;_Текущий слой
        (cons 10 '(0 0 0))
        (cons 11 '(0 0 0))
        (cons 51 (cdr(assoc 50 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
        (cons 41 (cdr(assoc 41 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
        (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)
  )
А можно ли всё-таки как-то предусмотреть ещё вариант оффсета полилинии (построенной или выбранной) на 20 мм внутрь? Только вот как дать программе понять, что в этом случае будет нужна площадь внутренней полилинии? И по поводу работы ЛИСПа в двух пространствах - никак? Придётся экспликации делать в пространстве модели?
Archeo вне форума  
 
Непрочитано 01.04.2010, 09:39
#55
Chapter

Инженер-проектировщик автомобильных дорог
 
Регистрация: 21.10.2009
Южно-Сахалинск
Сообщений: 245
<phrase 1=


Всем привет. Можно ли данный код приспособить так, чтобы он брал площадь объектов находящихся на одном слое и суммировал в одну ячейку, а когда я выбираю другой объект, который принадлежит другому слою, то он начинает в след ячейку суммировать площади этих объектов. В данном случае этот объект "Штриховка".
и чтобы можно было изначально забивать масштабы по x y. Вызвали команду задали масштабы (след вызывание должно быть подтверждение enter предыдущего значения или новое значение) потыкали в штриховку получили суммы штриховок с одинаковыми слоями в разных ячейках таблицы. Способом построчно например.

И можно например было бы сделать так чтобы нажимать на штриховки не по порядку по слойно, а например сначало нажали на слой1-в первую ячейку попала площадь, потом слой2-во вторую ячейку попала площадь, потом опять слой1-суммировала в первую ячейку с тем что там уже имеется. то есть тыкать в разнобой по штриховке и быть уверенным что по слойно все сложится правильно.

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

Вот все вроде что хочется.
Chapter вне форума  
 
Непрочитано 12.05.2010, 02:28
#56
DimAS]/[K

конструктор
 
Регистрация: 11.11.2006
Находка
Сообщений: 99
Отправить сообщение для DimAS]/[K с помощью Skype™


Присоединяюсь к этой просьбе:
Цитата:
Спасибо, почти всё работает. За исключением одного момента: когда прицеливаешься и выбираешь точку вставки, то текст с полем отображается подчёркнутым, а после вставки подчёркивание пропадает... Шо бы это значило?
очень нужно, чтобы площадь была подчеркнутой

Проблема временно решена этим лиспом
http://forum.dwg.ru/showpost.php?p=228481&postcount=14

Последний раз редактировалось DimAS]/[K, 12.05.2010 в 02:45.
DimAS]/[K вне форума  
 
Непрочитано 12.05.2010, 08:58
#57
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Делов то
в конце кода замените это:
Код:
[Выделить все]
(vlax-put txt 'TextString fld)
на это:
Код:
[Выделить все]
(vlax-put txt 'TextString (strcat "%%u" fld))
Пы.Сы. А если надо, чтоб в таблицу вставляло подчеркнутым, заменить эту строчку:
Код:
[Выделить все]
(or (vla-SetText tblobj row col fld) t)
на вот такую:
Код:
[Выделить все]
(or (vla-SetText tblobj row col (strcat "{\\L" fld "}")) t)

Последний раз редактировалось Do$, 12.05.2010 в 09:12. Причина: А про таблицу то я забыл...
Do$ вне форума  
 
Непрочитано 12.05.2010, 11:51
2 | #58
VVA

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


Для правильного формирования ObjectID в 64 разрядных системах нужно воспользоваться ф-цией, опубликованной Александром Ривилисом в этой теме
Код:
[Выделить все]
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;;--------------------------------------------------------
(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)
     )
  )
)
Цитата:
Сообщение от DimAS/K Посмотреть сообщение
очень нужно, чтобы площадь была подчеркнутой
Код:
[Выделить все]
;  Команда: 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;

;;http://forum.dwg.ru/showthread.php?t=14528&page=3
;;;;; FIELDDISPLAY
(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 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)
)
)
  (vl-load-com)
  (or *SCALE* (setq *SCALE* 1))
  (or *ULINE* (setq *ULINE* t)) ;_Подчеркивание
  (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)
      (princ "\nПодчеркивать текст [Да/Нет] <")(princ (if *ULINE* "Да" "Нет"))(princ "> : ")
      (initget  "Да Нет Yes No_ Yes No Yes No")
      (if (setq en (getkword))(setq *ULINE* (= en "Yes")))
      (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 "
             (Get-ObjectID-x86-x64 en)
                ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%ds44%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 (strcat (if *ULINE* "%%u" "") fld))
        (cons 7 (getvar "TEXTSTYLE")) ;_Текущий стиль
        (cons 8 "AREA") ;_Текущий слой
        (cons 10 '(0 0 0))
        (cons 11 '(0 0 0))
        (cons 51 (cdr(assoc 50 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
        (cons 41 (cdr(assoc 41 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
        (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 (strcat (if *ULINE* "{\\L" "") fld (if *ULINE* "}" ""))) 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 (strcat (if *ULINE* "%%u" "") fld))
      )
    )
  )
  (princ)
  )
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 13.05.2010 в 10:14.
VVA вне форума  
 
Непрочитано 12.05.2010, 18:25
#59
DimAS]/[K

конструктор
 
Регистрация: 11.11.2006
Находка
Сообщений: 99
Отправить сообщение для DimAS]/[K с помощью Skype™


спасибо вам ребята
DimAS]/[K вне форума  
 
Непрочитано 13.05.2010, 09:43
#60
DonJad


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


VVA - опередил!!! тоже была проблема с 64 битным акадом.

Пять минут назад нашел эту же функцию, и проапгрейдил ею скрипт.
DonJad вне форума  
 
Непрочитано 19.05.2010, 18:27
#61
Redya


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


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

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


Цитата:
Сообщение от Redya Посмотреть сообщение
Как быть?
Внимательно смотреть в командную строчку
Цитата:
Команда: areatt
Текущий масштаб = 1 Текущая точность округления = 2 Высота текста = 1.5
Префикс= Суффикс=
Перемещаться [по стРокам/по сТолбцам/Установки] <по сТолбцам>: У

Новый масштабный коэффициент <1> : 0.000001
Точность округления <2> : 3
Высота текста <1.5> :
Префикс (пробел - очистить) <> :
Суффикс (пробел - очистить) <> :
Перемещаться [по стРокам/по сТолбцам/Установки] <по сТолбцам>:
Укажите ячейку таблицы:
Выберите примитив для вставки его площади в таблицу (ENTER — завершение):
Выберите примитив для вставки его площади в таблицу (ENTER — завершение):
Чтобы задать по умолчанию метры квадратные найди в тексте строчку
Код:
[Выделить все]
  (or *SCALE* (setq *SCALE* 1))
Замени на
Код:
[Выделить все]
  (or *SCALE* (setq *SCALE* 0.000001))
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.05.2010, 18:48
#63
Redya


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


Offtop: VVA, я идиот, спасибо!
Redya вне форума  
 
Непрочитано 29.05.2010, 22:49
#64
Archeo

архитектор
 
Регистрация: 02.04.2006
Беларусь
Сообщений: 287


VVA, спасибо! Всё работает, просто супер!
Вот только жаль, оффсета нету Ну и ладно, значит, не судьба. Главное - работает.
Archeo вне форума  
 
Непрочитано 24.07.2010, 13:36
#65
Павлов Андрей

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


Здравствуйте .
VVA , подскажите пожалуйста , а можно ли сделать так , чтобы - указал как перемещаться , например по столбцам , ткнул в ячейку таблицы , а примитивы указывать не по одному , а рамкой ?
__________________
Andrey
Павлов Андрей вне форума  
 
Непрочитано 27.07.2010, 10:17
#66
VVA

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


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

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

;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.07.2010, 14:07
#67
Павлов Андрей

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


VVA .
Спасибо огромное !!!!!
Только вопрос : сортирует по времени отрисовки ?
__________________
Andrey
Павлов Андрей вне форума  
 
Непрочитано 27.07.2010, 16:00
#68
VVA

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


Цитата:
Сообщение от Павлов Андрей Посмотреть сообщение
Только вопрос : сортирует по времени отрисовки ?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 28.07.2010, 09:27
#69
Павлов Андрей

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


Здравствуйте .
Цитата:
Сообщение от VVA Посмотреть сообщение
сортирует по времени отрисовки ?
Т.е. я хотел сказать по времени создания примитива ?
__________________
Andrey
Павлов Андрей вне форума  
 
Непрочитано 21.10.2010, 07:29
#70
Shaft

отдел открытых горных работ
 
Регистрация: 06.05.2009
Новокузнецк
Сообщений: 124


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

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

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

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

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

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

ЗЗы. Спасибо большое за вашу программу. Позволяет, ощутимо, снизить кол-во рутинной работы!
Shaft вне форума  
 
Непрочитано 21.10.2010, 15:41
#71
VVA

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


Shaft, Обновил #2
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 22.10.2010, 05:13
#72
Shaft

отдел открытых горных работ
 
Регистрация: 06.05.2009
Новокузнецк
Сообщений: 124


Уважаемы VVA, Вы ГЕНИЙ! Безмерно Вам благодарен за помощь, которую Вы оказываете!!!
Это то, чего мне так не хватало! Теперь хватает!
Shaft вне форума  
 
Непрочитано 20.11.2010, 16:49
#73
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,260


1. У меня в таблице, состоящей из всего одной ячейки, поле, ссылающееся на длину некоей линии. Если я копирую ячейку и линию вместе, то поле новой ячейки - что логично - ссылается на первую линию, а не на новую. Можно ли каким-то образом (блок, группа или еще что-то) эту пару объектов размножать так, чтобы каждая новая ячейка ссылалась на "свою" линию?
2. Аналогично, в такой вот ячейке стоит поле - ссылка на ширину этой же ячейки. Если копирую ее, поле новой ссылается на ширину старой. Поправимо?
Была мысль делать это блоком, затем вставлять блок и сразу взрывать его. Так не выходит. Тупик?
Вложения
Тип файла: dwg
DWG 2007
Чертеж 1.dwg (140.6 Кб, 3384 просмотров)
skkkk на форуме  
 
Непрочитано 20.11.2010, 23:14
#74
Лиспер


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


skkkk, вопрос: а если вместе с таблицей копируется несколько отрезков? Как программно определить, к какой копии должно относиться поле?
__________________
(/= RegDate StartReadDate)
Лиспер вне форума  
 
Непрочитано 20.12.2010, 17:26 Вставить поле в атрибут блока
#75
Pavel23


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


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

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


Цитата:
Сообщение от Pavel23 Посмотреть сообщение
Коллеги, а никто не думал о том, что иногда нужно вставить поле в атрибут блока?
Посмотри здесь Area Field to Attribute
Цитата:
Program Description

This program allows a user to populate a selected attribute with a Field referencing the area, or sum of areas, of one or more objects.

The user is prompted to make a selection of objects for which to retrieve the area, if more than one object is selected the cumulative area for all objects will be displayed in the resultant Field.

Following object selection, the user is prompted to select an attribute to house the Field string. The Field will display the sum of the areas of the selected objects, formatted in the current units and precision of the drawing.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 22.12.2010, 16:13 Вставить поле в атрибут блока
#77
Pavel23


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


Огромное спасибо VVA! Протестил лисп, работает пока нормально, без траблов. Правда изначально программа вставляла поле с площадью, немного докрутил, теперь вставляет то, что надо, поле длины. Это большое подспорье, извлекаю кабельный журнал из блоков в которых прописывается кабло, поле длины раньше вставлял ручками, ну теперь ваще, прям цельный САПР...
Pavel23 вне форума  
 
Непрочитано 22.12.2010, 18:07
#78
Горян

конструктор СПК и НВФС
 
Регистрация: 13.04.2006
Сообщений: 47


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

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,260


Цитата:
Сообщение от Лиспер Посмотреть сообщение
skkkk, вопрос: а если вместе с таблицей копируется несколько отрезков? Как программно определить, к какой копии должно относиться поле?
Лиспер, условие моей задачи подразумевает одну линию, две мне попросту ни к чему
Я таки решил свою задачку с #73, обнаружив интересную закономерность (особенность) AutoCADa: Если блок вставить, а затем расчленить, то поле слетает, а если его вставить сразу с опцией Расчленить, то выходит, что можно
Цитата:
Сообщение от skkkk Посмотреть сообщение
эту пару объектов размножать так, чтобы каждая новая ячейка ссылалась на "свою" линию
Опция Расчленить вызывается установкой соответствующей галочки в окне Вставка блока (интерактивный режим, команда _insert), либо в прозрачном режиме (команда _-insert) на запрос опции имени блока вставкой звездочки (*) перед именем. Только остался вопрос к программистам: в лиспе, в конструкции
Код:
[Выделить все]
(command "_-insert" "*name"............)
звездочка не действует. Как быть?
skkkk на форуме  
 
Непрочитано 22.12.2010, 18:25
#80
VVA

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


skkkk, Только что проверил, действует.
Создай блок с именем "BLK". Код ниже вставит его расчлененным в точку 100,100
Код:
[Выделить все]
(command "_-insert" "*Blk" "100,100" 1 1 0)
>Pavel23 Проверю, но позже. Сейчас катастрофически не хватает времени
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 22.12.2010, 18:49
#81
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,260


Offtop: VVA, виноват, каюсь... Сразу не подумал, а дело вот в чем: блок был создан без галочки Разрешить расчленение, поэтому и не работало. Как же тогда, создавая блок программно, быть уверенным, что он расчленится?
skkkk на форуме  
 
Непрочитано 23.12.2010, 00:55
#82
Кулик Алексей aka kpblc
Moderator

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


Ну, раз создаешь блок программно, сразу и задавай ему "расчленяемость" в "Да"
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.12.2010, 01:30
#83
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,260


Offtop: Тут, видимо, речь не о командном методе, который, пожалуй, "полупрограммный" Знаю, надо осваивать visual... Вот праздники впереди...Придется вместо заняться
skkkk на форуме  
 
Непрочитано 23.12.2010, 09:44
#84
Pavel23


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


Коллеги, я не в теме, но подозреваю, что необходимо вставить в чертеж блок расчлененным. Если дело только в этом, то я решаю это так:
^C^C_-insert;BLK;\;;;_explode;_last;
Почему делаю так, внутри BLK, в моем случае, находится динамический блок с кучей атрибутов, преследую две цели, после расчленения блок у меня уже находится в определенном слое, который не нужно создавать, хотя вставляете в любой слой, и при вставке нет никакого диалога связанного со значениями атрибутов. Я конечно не профи, но думаю на лиспе будет так же:
(command "_-insert" "BLK" "\\" "" "" "")
(command "_explode" "_last")
Pavel23 вне форума  
 
Непрочитано 23.12.2010, 10:23
#85
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,260


Pavel23, с учетом #73 и #79 этот вариант не подходит, а виной тому - поля (fields) в ячейках таблицы, о чем повествует название темы

Добавлено:
на лиспе вместо "\\" используется pause pause:
Код:
[Выделить все]
(command "_-insert" "BLK" pause pause "" "")

Последний раз редактировалось skkkk, 23.12.2010 в 10:36.
skkkk на форуме  
 
Непрочитано 29.01.2011, 02:10
#86
a_leo


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


Прошу прощения за некомпетентность, но есть два вопроса:
1. можно ли в ячейку таблицы автоматом вставить текстовое значение ширины этой ячейки (форум просмотрел, похожее не нашел)
либо использовать ширину ячейки как параметр в формуле в этой либо другой ячейке
2. чем могут быть вызваны кракозябры вместо русских букв в запросах опций в автокаде в команде PTLB1.lsp (сама команда работает корректно). Пробовал менять кодировку на WIN1251, KOI8-R, UTF-8 - текстовый редактор отображает нормально, автокад - нет

Последний раз редактировалось a_leo, 29.01.2011 в 14:51.
a_leo вне форума  
 
Непрочитано 30.01.2011, 15:25
#87
VVA

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


Цитата:
Сообщение от a_leo Посмотреть сообщение
2. чем могут быть вызваны кракозябры вместо русских букв в запросах опций в автокаде в команде PTLB1.lsp
Попробуй скопировать еще раз, только убедись, что в момент копирования активна русская расладка клавиатуры
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 30.01.2011, 23:02
#88
Kraggash


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


VVA, спасибо большое за чудесную программку (ну и товарищам Громову с Ривилисом тоже спасибо конечно). Порадую архитекторов.
Тока у меня один вопрос. Как бы сделать так, чтобы разделителем в получаемых полях стала запятая. Заранее извиняюсь если тема уже поднималась, а я не заметил.
__________________
Автырь благодарит редактыря и корректыря за предоставленный ему шанец!
Kraggash вне форума  
 
Непрочитано 31.01.2011, 10:54
#89
VVA

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


Цитата:
Сообщение от Kraggash Посмотреть сообщение
Как бы сделать так, чтобы разделителем в получаемых полях стала запятая
В любом редакторе в поиске и замене (Ctrl+H)
Найти: %ct8
Наменить на: %ds44%ct8
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 02.02.2011, 09:37
#90
a_leo


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


Уважаемый VVA, премного благодарен за оперативный ответ
Цитата:
Попробуй скопировать еще раз, только убедись, что в момент копирования активна русская расладка клавиатуры
1. пробовал - для программы PTLB все замечательно работает
для программы PTLB1 (с caduser.ru, там где не поле, а текст) все равно кракозябры
2. а если имеется большое количество полилиний - можно ли организовать перебор т.е. после первой полилинии программа не завершает работу, а спрашивает вторую полилинию и т.д.

Последний раз редактировалось a_leo, 04.02.2011 в 21:54.
a_leo вне форума  
 
Непрочитано 10.02.2011, 10:58
#91
Shaft

отдел открытых горных работ
 
Регистрация: 06.05.2009
Новокузнецк
Сообщений: 124


Уважаемый VVA, можно ли наростить функционал вашей программы areatt следующим образом!
Чтобы можно было считать не только замкнутые контура, но и штриховки?
А то, на сегодняшний день приходиться вручную брать значение площади штриховки из ее свойст и суммировать\вычитать.
Shaft вне форума  
 
Непрочитано 10.02.2011, 12:49
#92
VVA

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


Shaft, Она работает с объектами, у которых есть свойство "площадь" (Area). В том числе и со штриховками. Допускаю, что возможен вариант, когда штриховка не имеет свойста Area.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 10.02.2011, 14:08
#93
Shaft

отдел открытых горных работ
 
Регистрация: 06.05.2009
Новокузнецк
Сообщений: 124


Блин VVA, ну вы волшебник!!!
А я прочитав описание, (в котором говорилось только про контур) даже и не пытался выбирать другие объекты!!! Кроме контура построенного полилинией.
Shaft вне форума  
 
Непрочитано 10.02.2011, 14:12
#94
VVA

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


Shaft, Не всегда верь написанному Используй научный метод - метод тыка
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 11.02.2011, 05:47
#95
Shaft

отдел открытых горных работ
 
Регистрация: 06.05.2009
Новокузнецк
Сообщений: 124


Цитата:
Сообщение от VVA Посмотреть сообщение
Shaft, Не всегда верь написанному Используй научный метод - метод тыка
Буду иметь это ввиду!

Блин в автокад (2006 и 2008) при попытки запустить вашу программу... автокад выдает следующее:
Код:
[Выделить все]
 Текущий масштаб = 1 Текущая точность округления = 2 Высота текста = 2.5 
Префикс=  Суффикс= ; ошибка: неверный тип аргумента: lselsetp nil
Может вы знаете в чем может быть проблема?

upd: и в 2011 такая же ошибка вылазиет. А вчера всё работало прекрасно.
Причем все вышеуказанные версии автокада находяться на разных компьютерах.
Ps. Может это восстание машин/или автокадов?


upd-2: [s]Я нашел ошибку! Оказывается надо создать таблицу до того как запускаешь комманду!
Просто раньше я как-то незапускал её в чертежах, где небыло таблиц. Поэтому и незнал что наличие последне
й является объязательным

Последний раз редактировалось Shaft, 11.02.2011 в 07:18.
Shaft вне форума  
 
Непрочитано 15.03.2011, 06:16
#96
Shaft

отдел открытых горных работ
 
Регистрация: 06.05.2009
Новокузнецк
Сообщений: 124


Ребята, подскажите, а можно вместо полощади заносить в таблицу длину объектов?
Зы. Поиском удалось найти только программки суммирующие длины. Но это совсем не то.
Shaft вне форума  
 
Непрочитано 15.03.2011, 12:05
#97
VVA

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


Shaft, Вернись в начало темы и почитай пост #3
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 15.03.2011, 13:39
#98
Shaft

отдел открытых горных работ
 
Регистрация: 06.05.2009
Новокузнецк
Сообщений: 124


Благодарю Вас уважаемый VVA, ведь я помнил что видел что-то подобное, а найти поиском несмог.
А оказалось что было всё у меня под носом.
Shaft вне форума  
 
Непрочитано 14.04.2011, 06:01
#99
DimAS]/[K

конструктор
 
Регистрация: 11.11.2006
Находка
Сообщений: 99
Отправить сообщение для DimAS]/[K с помощью Skype™


а можно ли сделать так чтобы лисп считал и выводил поле с площадью множества полилиний. такого вида:

т. е. выбираешь команду, выбираешь кучу полилиний, выводишь поле в текст, атрибут или ячейку таблички
p. s. извиняюсь если подобной решение уже есть, но искал такого не нашел. Нужно просто подсчитывать общие площади также автоматом.
DimAS]/[K вне форума  
 
Непрочитано 14.04.2011, 10:33
#100
VVA

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


Вариант с суммирование (вычитанием) площадей из #2 не подойдет?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 15.04.2011, 02:10
#101
DimAS]/[K

конструктор
 
Регистрация: 11.11.2006
Находка
Сообщений: 99
Отправить сообщение для DimAS]/[K с помощью Skype™


подойдет, только нужно чтобы обязательно работал с атрибутами (вставлялся в них).
И почему-то при суммировании площадей не работает коэффициент и количество знаков округления. Когда одну площадь указываешь, то все работает, когда суммируешь или вычитаешь, не работает так, как надо.

Последний раз редактировалось DimAS]/[K, 15.04.2011 в 02:47.
DimAS]/[K вне форума  
 
Непрочитано 16.04.2011, 09:57
#102
VVA

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


Цитата:
Сообщение от DimAS
/[K;736435]подойдет, только нужно чтобы обязательно работал с атрибутами (вставлялся в них).
Посмотри это Area Field to Attribute
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.04.2011, 17:58
#103
Агент СмиТ

Gti
 
Регистрация: 14.01.2010
МО Железнодорожный
Сообщений: 121


Уважаемый VVA!
Пользую ваш лисп MAREATT - очень полезная вещь для землеустроителя, спасибо Вам! Однако когда решил воспользоваться PTLB для вставки площади замкнутой полилинии в пространство модели, столкнулся со следующим отказом в работе программы:

Цитата:
Команда: (if (not C:PTLB) (load "ptlb"))
nil

Команда: PTLB

Что будем считать [Длина/Площадь] <Длина> :_A

Текущий масштаб: линейный = 1.0 площадной = 0.0001 Текущая точность округления
= 4 Высота текста = 5.0 Префикс= Суффикс= га
<Площадь> Выберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: _S

Новый линейный масштабный коэффициент <1.0> : 1

Новый площадной масштабный коэффициент <0.0001> : 0.0001

Точность округления <4> : 4

Высота текста <5.0> : 5

Префикс (пробел - очистить) <> :

Суффикс (пробел - очистить) <га> : га

<Площадь> Выберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: В

Выберите полилинию, круг, сплайн, эллипс или дугу
Выберите объекты:

Найдено полей: 1.
Обновлено полей: 1.
Укажите точку вставки текста или ячейку таблицы:; ошибка: Ошибка Automation.
На блокированном слое
После выбора объекта рядом с перекрестьем курсора появляется значение площади, но при нажатии ЛКМ, вместо цифр в поле появляется значение вида "######", а при попытке отредактировать поле появляется сообщение
Цитата:
Объект, на который ссылается поле, некорректен
Работаю в 2011 Акаде, попробовал добавить в код программы строку :

Цитата:
(cond
((= Aver 18.1) 2011)
((= Aver 18.0) 2010)
((= Aver 17.2) 2009)
((= Aver 17.1) 2008)
((= Aver 17.0) 2007)
но видимых результатов это не принесло. Подскажите пожалуйста, в чём загвоздка?
Агент СмиТ вне форума  
 
Непрочитано 18.04.2011, 20:19
#104
VVA

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


Агент СмиТ, Для начала давай так:
1. Из поста #3 копируешь последнюю версию
2. Пробуешь. Если есть ошибка, то выкладываешь тестовый файл и сообщаешь: версию Автокада с указанием разрядности, версию операционной системы с указанием разрядности, наличие/отсутсвие сервис паков для Автокада
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 19.04.2011, 11:17
#105
Агент СмиТ

Gti
 
Регистрация: 14.01.2010
МО Железнодорожный
Сообщений: 121


VVA, Скачал лисп из поста #3, для начала испробовал во вновь созданном файле и... всё сразу же заработало! Однако в рабочем файле отказ не ушел. Через два часа , методом последовательных итераций выяснил, что всё дело было в наличии таблицы на заблокированном слое, при разблокировании которой, лисп позволяет вставлять поле и в произвольную точку пространства модели, пространство листа не тестировал, но думаю что и там возможны подобные нюансы.
Посмотрите пожалуйста, можно ли устранить данный баг хотя бы в пространстве модели! Файл чертежа прикладываю.
Вложения
Тип файла: dwg
DWG 2010
Чертеж1.dwg (112.4 Кб, 3179 просмотров)
Агент СмиТ вне форума  
 
Непрочитано 19.04.2011, 20:38
#106
VVA

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


Агент СмиТ, Обновил #3 побуй
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.04.2011, 12:38
#107
Агент СмиТ

Gti
 
Регистрация: 14.01.2010
МО Железнодорожный
Сообщений: 121


VVA
Обновил лисп в акаде, запустил из командной строки, вот листинг:
Цитата:
Команда: ptlb
Что будем считать [Длина/Площадь] <Длина> :П
Текущий масштаб: линейный = 1.0 площадной = 0.001 Текущая точность округления =
2 Высота текста = 5.0 Префикс= Суффикс= м2
<Площадь> Выберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: В
неверный тип аргумента: VLA-OBJECT nil
Программа не даёт выбрать объект.
Агент СмиТ вне форума  
 
Непрочитано 20.04.2011, 13:06
#108
VVA

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


Скопируй еще раз. Должно писать это
Цитата:
Команда PTLB. Версия от 19.04.2011
http://forum.dwg.ru/showpost.php?p=183237&postcount=3

Команда:
Команда: ptlb

Что будем считать [Длина/Площадь] <Длина> :п
Текущий масштаб: линейный = 1 площадной = 1 Текущая точность округления = 2
Высота текста = 1.5 Префикс= Суффикс=
<Площадь> Выберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: в
Выберите полилинию, круг, сплайн, эллипс или дугу
Выберите объекты:

Найдено полей: 1.
Обновлено полей: 1.
Укажите точку вставки текста или ячейку таблицы:
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 20.04.2011, 13:37
#109
Агент СмиТ

Gti
 
Регистрация: 14.01.2010
МО Железнодорожный
Сообщений: 121


Цитата:
Команда: properties

Команда:
Команда:
Команда: _appload ptlb.lsp успешно загружено.


Команда:
Команда PTLB. Версия от 19.04.2011
http://forum.dwg.ru/showpost.php?p=183237&postcount=3
Команда:
Команда: PTLB

Что будем считать [Длина/Площадь] <Длина> :П

Текущий масштаб: линейный = 1 площадной = 1 Текущая точность округления = 2
Высота текста = 2.5 Префикс= Суффикс=
<Площадь> Выберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>: В
неверный тип аргумента: VLA-OBJECT nil
Команда:
Команда: *Прервано*
Та же ошибка.
Агент СмиТ вне форума  
 
Непрочитано 20.04.2011, 15:34
#110
VVA

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


Исправил #3 Пробуй снова
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.04.2011, 18:18
#111
Агент СмиТ

Gti
 
Регистрация: 14.01.2010
МО Железнодорожный
Сообщений: 121


Спасибо, VVA! Всё отлично работает! Приступаю к труду на благо общества
Агент СмиТ вне форума  
 
Непрочитано 14.11.2011, 12:57
#112
APavl


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


Здравствуйте .
Подскажите , пожалуйста : можно ли заставить работать PTLB с таблицей ATABLE с сайта http://alxd.it-dept.ru/index.php может кто-то пробовал уже ?
Спасибо заранее .
APavl вне форума  
 
Непрочитано 14.01.2012, 14:26
#113
lovial

Инженер
 
Регистрация: 12.11.2008
Днепропетровск
Сообщений: 525


Как-то перерыл множество лиспов и нашел нужный - по клику в пространстве, ограниченном отрезками, выводит текст с площадью (т.е. сам создает контур). Однако куда-то его затаскал и найти в куче всего не получилось. Ткните, если можно, носом в пост/ссылку...
lovial вне форума  
 
Непрочитано 15.01.2012, 01:59
#114
dew


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


Ребята а можно ли данный лисп ввести функцию ввода префикса при каждом измерении для того чтобы можно было одновременно еще и помещения подписывать ??? только желательно чтобы через дробь записывала с верху суффикс, а под чертой площадь ????? Заранее спасибо очень полезный лисп.....!!!!!
Код:
[Выделить все]
;  Команда: 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;

;;http://forum.dwg.ru/showthread.php?t=14528&page=3
;;;;; FIELDDISPLAY
(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 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)
)
)
  (vl-load-com)
  (or *SCALE* (setq *SCALE* 1))
  (or *ULINE* (setq *ULINE* t)) ;_Подчеркивание
  (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)
      (princ "\nПодчеркивать текст [Да/Нет] <")(princ (if *ULINE* "Да" "Нет"))(princ "> : ")
      (initget  "Да Нет Yes No_ Yes No Yes No")
      (if (setq en (getkword))(setq *ULINE* (= en "Yes")))
      (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 "
             (Get-ObjectID-x86-x64 en)
                ">%).Area \\f \"%lu2%ps["*PREF* "," *SUFF*
                "]%ds44%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 (strcat (if *ULINE* "%%u" "") fld))
        (cons 7 (getvar "TEXTSTYLE")) ;_Текущий стиль
        (cons 8 "AREA") ;_Текущий слой
        (cons 10 '(0 0 0))
        (cons 11 '(0 0 0))
        (cons 51 (cdr(assoc 50 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
        (cons 41 (cdr(assoc 41 (entget(TBLOBJNAME "STYLE" (getvar "TEXTSTYLE"))))))
        (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 (strcat (if *ULINE* "{\\L" "") fld (if *ULINE* "}" ""))) 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 (strcat (if *ULINE* "%%u" "") fld))
      )
    )
  )
  (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)
     )
  )
)

Последний раз редактировалось dew, 15.01.2012 в 03:32.
dew вне форума  
 
Непрочитано 01.02.2012, 17:10
#115
APavl


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


Здравствуйте . А можно сделать чтобы площади/длины выделенных примитивов выводились в файл Excel ?
APavl вне форума  
 
Непрочитано 01.02.2012, 18:46
#116
VVA

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


APavl,
1. Можно создать связь таблицы Автокада с таблицей Excell
2. Как вывести в эксель длинны нескольких линий?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 02.02.2012, 03:25
#117
Largo GT

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


Цитата:
Сообщение от lovial Посмотреть сообщение
Как-то перерыл множество лиспов и нашел нужный - по клику в пространстве, ограниченном отрезками, выводит текст с площадью (т.е. сам создает контур). Однако куда-то его затаскал и найти в куче всего не получилось. Ткните, если можно, носом в пост/ссылку...
Если еще интересует... такое есть или в "G_Tools" или
в "VetCAD++"
Largo GT вне форума  
 
Непрочитано 02.02.2012, 10:19
#118
APavl


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


VVA, Спасибо за ссылку .
Я вставляю в ACAD 2008 связанную таблицу со спецификацией из Excel (просто там всё гарантированно считается , в таблице Acad нужно ещё проверять) . Слышал , что в более поздних версиях ACAD можно вставлять двустороннюю связь таблиц acad-excel , но у меня acad 2012 вылетает постоянно из-за нехватки памяти . Поэтому длины беру из acadа , считаю в excele , вставляю спецификацию обратно в acad . Хорошо бы ещё показывало количество , одинаковые длины складывало .... Но , наверное , многого хочу .
APavl вне форума  
 
Непрочитано 15.03.2012, 15:38
#119
shartal


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


В команде PTLB точность настраивается для знаков после запятой. При вставке в таблицу длины арматуры в мм, требуется округление до 0 или 5 (1357 в 1360). возможно ли это реализовать?
shartal вне форума  
 
Непрочитано 19.03.2012, 14:38
1 | #120
VVA

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


shartal, Обновил #3 Добавилась новая настройка - округление. Тестируй.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.03.2012, 09:46
#121
serdgius

Архитектор
 
Регистрация: 22.02.2007
Красноярск
Сообщений: 20
<phrase 1=


Почему то PAREATLB в 2010 не хочет работать в 2007 проверил работает. В чем может быть проблема?
Миниатюры
Нажмите на изображение для увеличения
Название: Безимени-1.jpg
Просмотров: 142
Размер:	589.8 Кб
ID:	76804  
serdgius вне форума  
 
Непрочитано 21.03.2012, 10:10
#122
VVA

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


serdgius, Дай ссылку на пост где брал. Исправлю. А вообще дело в функции whatAcadVer. Замени на эту
Код:
[Выделить все]
(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)
)
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 21.03.2012, 10:42
#123
serdgius

Архитектор
 
Регистрация: 22.02.2007
Красноярск
Сообщений: 20
<phrase 1=


Пост №1 исправленный который. Попытался вставить, без изменений, я в лиспе не силен. Буду премного, если поможете. Такой еще вопрос в Area Field to Attribute, как нибудъ можно менять маштабный коэффициент, или может есть еще подобный лисп.

Последний раз редактировалось serdgius, 21.03.2012 в 10:49.
serdgius вне форума  
 
Непрочитано 21.03.2012, 13:54
#124
VVA

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


В #3 есть дальнейшее развитие этой команды. Посмотри, может понравится. По поводу замены ничего сложного нет. В #1 изменить не могу, писал не я. Выложу вариант здесь
Код:
[Выделить все]
 
; Команда: 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 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)
)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.04.2012, 14:37
#125
shartal


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


При вставке в таблицу \ или / убивается и в ячейке оказывается только код символа U+E738.
shartal вне форума  
 
Непрочитано 06.04.2012, 16:28
#126
Кулик Алексей aka kpblc
Moderator

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


попробуй использовать двойной слеш: "\\"
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 09.04.2012, 08:33
#127
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,683
Отправить сообщение для Do$ с помощью Skype™


Я с таким сталкивался, когда использовал метод vla-get-textstring, он строки с символами юникода вот так вот коверкает. Мне пришлось отказаться от vla и заменить (vla-get-textstring obj) на конструкцию (cdr (assoc 1 (entget (vlax-vla-object->ename obj)))). Может здесь то же самое.
Do$ вне форума  
 
Непрочитано 09.04.2012, 17:10
#128
shartal


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


Два \\ только с ком строки можно использовать. Макрос на строке с \ останавливается.
Нашел способ прописать с \\\ прямо в формирование поля в код.
shartal вне форума  
 
Непрочитано 17.04.2012, 14:24
#129
Positron


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Positron,
Код:
[Выделить все]
(defun C:DIMTLB ( / cmdname fld txt tblset tblobj row col dimtxt
                 whatAcadVer tstyle what
                 ss dim1 dim2 dim3)
(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 0)
)
)
  (vl-load-com)
 (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (and
    (or ;_ > Проверяем версию
      (> (whatAcadVer) 2005)
      (alert "\nНужен Автокад версии 2006 и выше")
      ) ;_ < Проверяем версию
    (princ "\nВыберите 1-й размер")
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim1 (vlax-ename->vla-object(ssname ss 0)))
     (setq dimtxt (strcat (vl-princ-to-string(vla-get-measurement dim1)) " x"))
    (or (vla-Highlight dim1 :vlax-true) t)
    (princ "\nВыберите 2-й размер : ")(princ dimtxt)
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim2 (vlax-ename->vla-object(ssname ss 0)))
    (or (vla-Highlight dim2 :vlax-true) t)
    (setq dimtxt (strcat dimtxt (vl-princ-to-string(vla-get-measurement dim2)) " x"))
    (princ "\nВыберите 3-й размер : ")(princ dimtxt)
    (setq ss nil ss (ssget "_+.:E:S" '((0 . "DIMENSION"))))
    (setq dim3 (vlax-ename->vla-object(ssname ss 0)))
    (or (vla-Highlight dim3 :vlax-true) t)
    (princ (setq dimtxt (strcat dimtxt " " (vl-princ-to-string(vla-get-measurement dim3)))))
  ;_ Формируем поле
  ;;;  %<\AcObjProp Object(%<\_ObjId 2130564848>%).Measurement \f "%lu2%pr0">%
    (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(vla-get-objectid dim1))
                ">%).Measurement \\f \"%lu2%pr0\">%"
                "x"
                "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(vla-get-objectid dim2))
                ">%).Measurement \\f \"%lu2%pr0\">%"
                "x"
               "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(vla-get-objectid dim3))
               ">%).Measurement \\f \"%lu2%pr0\">%"
                ) ;_ strcat
          ) ;_ setq
  (or (vla-Highlight dim1 :vlax-false)
      (vla-Highlight dim2 :vlax-false)
      (vla-Highlight dim3 :vlax-false)
   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 Укажите точку вставки текста или ячейку таблицы(")(princ dimtxt)(princ ") :")
  (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)
  )

Плиз, помогите в автокаде версии 2012 не пашет, чо дописать надо шоб работало? и сразу для 2013 еси не трудно..

--- Разабрался ((= Aver 18.0) 2010) ((= Aver 18.1) 2011) ((= Aver 18.2) 2012)
А 2013 будет 19.0 ????

Последний раз редактировалось Positron, 17.04.2012 в 17:52.
Positron вне форума  
 
Непрочитано 17.04.2012, 18:34
#130
VVA

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


Вместо
Код:
[Выделить все]
(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 0)
)
Впиши
Код:
[Выделить все]
(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)
)
В коде проверяется Автокад версии 2006 и выше (появились формулы) или нет. На сегодняшний момент мало у кто уже работает в 2005 и ниже Автокаде. Так что проверку вообще можно убрать. Замени функцию
Код:
[Выделить все]
(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 0)
)
)
на
Код:
[Выделить все]
(defun whatAcadVer ( / Aver)2011)
и забей забудь про проблему
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 18.04.2012, 10:57
#131
Positron


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


Цитата:
Сообщение от VVA Посмотреть сообщение
Вместо
Код:
[Выделить все]
(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 0)
)
Впиши
Код:
[Выделить все]
(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)
)
В коде проверяется Автокад версии 2006 и выше (появились формулы) или нет. На сегодняшний момент мало у кто уже работает в 2005 и ниже Автокаде. Так что проверку вообще можно убрать. Замени функцию
Код:
[Выделить все]
(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 0)
)
)
на
Код:
[Выделить все]
(defun whatAcadVer ( / Aver)2011)
и забей забудь про проблему
спасибо
Positron вне форума  
 
Непрочитано 04.05.2012, 13:48
#132
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


Уважаемый VVA, в посте #1 (2007-09-20 16:36:57) в коде лиспа PAREATAB написано
Цитата:
; Код можно сохранить в файле 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)
Я красным выделила, это опечатка? Надо так?
Цитата:
defun C:PAREATAB
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 06.05.2012, 11:48
#133
VVA

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


Nata1,Спасибо за внимательность. Да в этом посте надо так. Исправить не могу, т.к. пост не мой. Скажу лишь, что после этой публикации команды менялись. Дальнейшее развити есть в посте #3, в том числе там есть ссылка и на обновленную PAREATLB
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 11.05.2012, 10:32
#134
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


Спасибо за лиспы, очень нужная вещь.
Попробовала лисп AREATT
Вариант с суммирование (вычитанием) площадей из поста #2
и заметила особенность. Вводишь масштабный коэффициент, например, 0.01, а он после применения "+" или "-" сбивается и в таблице записывается с коэффициентом 1.
Может, я не правильно команду использую? Делаю так:

Цитата:
Команда: AREATT

Текущий масштаб = 0.01 Текущая точность округления = 2 Высота текста = 2.0
Префикс= Суффикс=
Перемещаться [по стРокам/по сТолбцам/Установки] <по сТолбцам>:

Укажите ячейку таблицы:
Выберите примитив для вставки его площади в таблицу (+ сумма; - вычитание;
ENTER — завершение): +

ENTER

СУММИРОВАНИЕ > Выберите примитив для вставки его площади в таблицу (ENTER —
завершение):

Выбираю объект ENTER

СУММИРОВАНИЕ > Выберите примитив для вставки его площади в таблицу (ENTER —
завершение):

Выбираю объект ENTER

Выберите примитив для вставки его площади в таблицу (+ сумма; - вычитание;
ENTER — завершение):
В таблице выводится сумма выбранных объектов, но без указанного коэффициента, а после выбора суммирования или вычитания ввести коэффициент уже нельзя.
В других лиспах из этой темы нет возможности суммирования/вычитания полей.
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 11.05.2012, 13:55
#135
VVA

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


Nata1, Я попробовал, у меня масштаб сохраняется. Посмотри содержимое поля, там должно быть что-то похожее на
Цитата:
%<\AcObjProp.16.2 Object(%<\_ObjId 2127578448>%).Area \f "%lu2%pr3%ct8[0.01]">%
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 11.05.2012, 14:41
#136
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


VVA, да, именно так и есть. На первом скрине "Окно1" поле, которое у меня получилось после вычитания полей. Мне пришлось вручную заменять точку на запятую, менять масштабный коэффициент, формат и точность. Тогда стало все, как надо. См. второй скрин "Окно2"
По идее, должно ведь все автоматически делаться. Может, какие-то настройки полей поменять надо?
Миниатюры
Нажмите на изображение для увеличения
Название: Окно1.jpg
Просмотров: 126
Размер:	178.6 Кб
ID:	79997  Нажмите на изображение для увеличения
Название: Окно2.jpg
Просмотров: 110
Размер:	177.8 Кб
ID:	79998  
__________________
AutoCAD 2014

Последний раз редактировалось Nata1, 11.05.2012 в 15:24. Причина: Добавление вложения "Окно3"
Nata1 вне форума  
 
Непрочитано 11.05.2012, 21:04
#137
VVA

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


Nata1,мне нужно содержимое поля в формуле. Тебе нужно дважды щелкнуть на цифре 91.90 из 1-го рисунка.И ничего не меняй в ручную, просто скопируй сюда содержимое поля. Еще меня настораживает фраза
Цитата:
Сообщение от Nata1 Посмотреть сообщение
Мне пришлось вручную заменять точку на запятую
Какие у табя региональные настройки в Windows?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 12.05.2012, 08:40
#138
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


VVA, спасибо! Вот, что в поле написано:
Это для обеих цифр, если выбрать в ячейке таблицы "Редактировать поле":
Цитата:
%<\AcExpr (%<\_FldPtr 364517392>%-%<\_FldPtr 364516128>%)>%
Это, если щелкнуть на 91.90
Цитата:
%<\AcObjProp.16.2 Object(%<\_ObjId 2129725528>%).Area \f "%lu2%pr2%ds44%ct8[0.01]">%
А это при щелчке на 0.25
Цитата:
%<\AcObjProp.16.2 Object(%<\_ObjId 2129727520>%).Area \f "%lu2%pr2%ds44%ct8[0.01]">%
И уже вижу, по отдельности коэффициент в полях стоит, а в суммарном поле его нет. И в отдельных цифрах запятая, а не точка, а в сумме получается точка.
Повторю, что введенный коэффициент не сохраняется и вместо точки ставится запятая только при применении сложения/вычитания. У меня начерчено в модели в масштабе 1:100 и поэтому у полей тоже делаю такой масштаб.
Цитата:
Какие у табя региональные настройки в Windows?
А где это смотреть? У меня вроде никогда не было проблем с точкой и запятой в автокаде.
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 15.05.2012, 09:20
#139
VVA

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


Nata1, Мне не понятно откуда в поле берется (разделитель - запятая)
Цитата:
%<\AcObjProp.16.2 Object(%<\_ObjId 2129727520>%).Area \f "%lu2%pr2%ds44%ct8[0.01]">%
Я его в команде не формирую. Региональные настройки смотри в
Пуск -> Панель управления
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 15.05.2012, 10:12
#140
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


Настройки посмотрела. Точка стоит.
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 15.05.2012, 11:48
#141
VVA

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


Nata1, приложи файлик
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 15.05.2012, 13:56
#142
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


VVA, вот.
Вложения
Тип файла: dwg
DWG 2007
2Этаж.dwg (109.6 Кб, 4042 просмотров)
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 15.05.2012, 17:56
#143
VVA

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


Nata1, Добавил форматирование (площадь, точность) и для всей формулы. См #2
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.05.2012, 08:45
#144
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


VVA, спасибо, стало гораздо удобнее. Только теперь вместо запятой всегда точка ставится, и при суммировании(вычитании) и без.
Точку сама исправила согласно поста 89
http://forum.dwg.ru/showpost.php?p=693051&postcount=89
Миниатюры
Нажмите на изображение для увеличения
Название: Точка вместо запятой.jpg
Просмотров: 121
Размер:	186.0 Кб
ID:	80319  
Вложения
Тип файла: dwg
DWG 2007
2Этаж.dwg (98.8 Кб, 4034 просмотров)
__________________
AutoCAD 2014

Последний раз редактировалось Nata1, 16.05.2012 в 10:04. Причина: Поняла
Nata1 вне форума  
 
Непрочитано 16.05.2012, 09:59
#145
VVA

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


Цитата:
Только теперь вместо запятой всегда точка ставится
Я уже писал в #139
Цитата:
Мне не понятно откуда в поле берется (разделитель - запятая) ... Я его в команде не формирую
Внес очередные изменения. Добавил в настройку разделитель. См. #2
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.05.2012, 10:07
#146
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


VVA, спасибо!
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 14.06.2012, 14:31
#147
esp1413


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


Autocad 2012. Не работает:

Команда: _appload AreaToTab.lsp успешно загружено.
Команда:
Команда:
Команда: PAREATLB
Текущий масштаб = 1 Текущая точность округления = 2 Высота текста = 500.0
Префикс= Суффикс=
Выберите или нарисуйте [Полилиния/Установки/Выбор] <Выбор>:
Выберите полилинию, круг, сплайн, эллипс или дугу
Выберите объекты:
Найдено полей: 1.
Обновлено полей: 1.
Укажите точку вставки текста или ячейку таблицы:Неизвестная команда "NONE".
Для вызова справки нажмите F1.
*Прервано*

Прерывает после указания примитива.

Использовал вот это:
Код:
[Выделить все]
; Команда: 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)
(defun whatAcadVer ( / Aver)2012)
(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)
)
esp1413 вне форума  
 
Непрочитано 15.06.2012, 11:53
#148
APavl


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


Выберите полилинию, круг, сплайн, эллипс или дугу
Выберите объекты:
Найдено полей: 1.
Обновлено полей: 1.
Укажите точку вставки текста или ячейку таблицы:Неизвестная команда "NONE".
Для вызова справки нажмите F1.
*Прервано*
Прерывает после указания примитива.


Здравствуйте . Было то же самое . Как-то потом исчезло чудесным образом . Может даже после перезагрузки ... Как-то и не помню сейчас .
APavl вне форума  
 
Непрочитано 22.06.2012, 10:38
#149
owerty


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


На основе PAREATLB хочу создать / изменить код, но нехватает знаний.
запросы от пользователя:

Масштабный коэффициент:
Количество десятичных знаков:
Округлять [Да/Нет] : (Да- стандартное округление, Нет- не округлять (отбросить лишние цифры / округлить в меньшую сторону)
Высота текста : 250
Подчеркивать текст [Да/Нет] :

Помогите, пожалуйста, разобраться с округлением

Последний раз редактировалось owerty, 22.06.2012 в 14:45. Причина: исправлено
owerty вне форума  
 
Непрочитано 23.06.2012, 15:35
#150
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,260


Цитата:
Сообщение от owerty Посмотреть сообщение
Помогите, пожалуйста, разобраться с округлением
Overty, хотелось бы для начала разобраться вот с этими несколькими пунктиками:
1. Что в данном контексте понимается под "стандартным округлением"? Текущее значение системной переменной или 2 знака или еще что-то?
2. Что же всё-таки должно происходить при нажатии Нет: "неокругление", отброс лишних цифр или округление в меньшую сторону? А может выпадение следующего меню со всеми этими пунктами?
3. Лишние цифры - это какие? Хвостовые нули? Или которые не помещаются куда-нибудь, в ячейку, например?
4. Округлить в меньшую сторону - это до меньшего целого или до стольких знаков, сколько указывает пользователь пунктом выше (Количество десятичных знаков:)?
А еще лучше изобразить бы непосредственно в dwg, например, как во вложении
Вложения
Тип файла: dwg
DWG 2010
Чертеж1.dwg (68.2 Кб, 4042 просмотров)
skkkk на форуме  
 
Непрочитано 23.06.2012, 21:59
#151
VVA

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


esp1413,
Цитата:
Сообщение от esp1413 Посмотреть сообщение
Autocad 2012. Не работает:
Проверю после выхода из отпуска
owerty, К вопросам skkkk мне пока добавить нечего.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 25.06.2012, 20:10
#152
owerty


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


-Количество десятичных знаков:
-Округлять [Да/Нет] :
Да- математическое округление к ближайшему "целому",
Нет- отбросить лишние цифры, следующие после количества, указанного в пред.запросе)

Чертеж2.dwg

Последний раз редактировалось owerty, 25.06.2012 в 20:18.
owerty вне форума  
 
Непрочитано 24.08.2012, 12:56
#153
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


Уважаемый VVA, можно ли немного доработать лисп AREATT (вариант с суммированием/вычитанием площадей, чтобы можно было суммировать/вычитать площади объектов, образованных группой. Например, при подсчете площади помещения на плане, обвести контур помещения полилинией, а все колонны заранее сгруппировать командой GROUP и при запросе на выделение объекта сразу всю группу выделить, а не тыркать курсором в каждую колонну.
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 24.08.2012, 17:15
#154
VVA

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


Тестируй. Можно группировать, можно выбирать рамкой/секрамкой
Предыдущие здесь
Код:
[Выделить все]
(defun C:ATTSS ( / en obj tblobj row col lst pt rows cols what fld str ss *error*)
;;;;  Команда: ATTSS (AREA To Table with Sum and Select)
;;;;  posted http://forum.dwg.ru/showthread.php?p=962978#post962978
;;;; Владимир Азарко (VVA) для www.dwg.ru
;;;; Вариант с суммированием, где при суммировании или вычитании используется выбор объектов ssget'ом.
;;;; Это дает возможность выбирать рамкой, секрамкой или группой, если объеты предварительно сруппировать командой _GROUP
;;;;  и включить группировку. Переменная PICKSTYLE=1 или сочетание клавиш CTRL+H
;;;;  Эта команда позволяет вставлять начиная с указанной ячейки таблицы
;;;;  текст с полем (FIELD), содержащее значение площади выбранного контура.
;;;;  В зависимости от выбора, навигация по таблице идет по строкам или столбцам.
;;;;  Если строки или столбцы заканчиваются, то они автоматически добавляются.
;;;;  Форматирование ячейки берется как у первой указанной.
;;;;  Точность округления и масштабный коэффициент настраиваются через опцию Установки
;;;;  Так как это поле связано с конкретным объектом, то при изменении
;;;;  объекта поле пересчитывается (необходимо обновление поля)
;;;;  Код можно сохранить в файле attss.lsp
;;;;  Возможный макрос для кнопки или пункта меню:
;;;;  ^C^C(if (not C:ATTSS)(load "ATTSS"));ATTSS;
  (vl-load-com)
(defun *error* (msg)(while (> (getvar "CMDACTIVE") 0) (command))
 (princ message)(princ))
  (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
       ((and (member en '("+" "-"))
             (setq ss (mip-ssentget-by-type (strcat (if (= en "+") "СУММИРОВАНИЕ > " "ВЫЧИТАНИЕ > ") "Выбери полилинию") '("LWPOLYLINE" "CIRCLE") 14))
             )
	(setq str en fld "%<\\AcExpr (" lst (lib:conv-pickset-to-list ss))
        (foreach en lst
	  (if (vlax-property-available-p (setq en (vlax-ename->vla-object en)) 'Area)
	    (progn
	      (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)) (mapcar 'vlax-ename->vla-object 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)
)
(defun mip-ssentget-by-type (msg types bits / sel cmd_lst) 
;;; 
;;; Параметры: 
;;; msg - краткое приглашение для выбора, допускается NIL 
;;; bits - целое от 0 до 15, битовый переключатель, значения битов: 
;;;    1 - разрешение выбора на заблокированном слое 
;;;    2 - разрешение многократного выбора 
;;;    4 - разрешение выбора рамкой / секрамкой 
;;;    8 - возвращать набор 
;;; types - список имен допустимых типов примитивов, допускается NIL 
;;; 
;;; Пример: 
;;; (mip-ssentget-by-type "Выбери отрезок или полилинию" '("LINE" "LWPOLYLINE") 14) 
;;; 
;;; Возвращает имя _первого_ примитива из попавших в набор, при удачном выборе 
;;; или NIL при отказе с помощью Enter или прерывании по Esc, в последнем случае, 
;;; одновременно выводит сообщение о прерывании в командную строку. 
;;; 
;;; При наличииии любого из битов: 2, 4 или 8 и при успешном выборе, возвращает 
;;; не имя примитива, а набор. 
;;; 
  (setq msg     (strcat "\n" 
                        (if msg 
                          (strcat msg " ") 
                          "" 
                        ) 
                        (if (= (strcase (getvar "SYSCODEPAGE")) "ANSI_1251") 
                          "<Выход>" 
                          "<Exit>" 
                        ) 
                ) 
        cmd_lst (if (= (logand bits 2) 0) 
                  ":S" 
                  "" 
                ) 
        cmd_lst (if (= (logand bits 4) 0) 
                  (strcat cmd_lst ":E") 
                  cmd_lst 
                ) 
        cmd_lst (if (= (logand bits 1) 0) 
                  (strcat cmd_lst ":L") 
                  cmd_lst 
                ) 
        cmd_lst (if (/= cmd_lst "") 
                  (list (strcat "_" cmd_lst)) 
                ) 
        types   (mapcar (function (lambda (x) (cons 0 x))) types) 
  ) 
  (if (and types (> (length types) 1)) 
    (setq types (append (cons '(-4 . "<OR") types) '((-4 . "OR>")))) 
  ) 
  (if types 
    (setq cmd_lst (append cmd_lst (list types))) 
  ) 
  (setvar "ERRNO" 0) 
  (while (and (/= (getvar "ERRNO") 52) (not sel)) 
    (princ msg) 
    (setvar "nomutt" 1) 
    (vl-catch-all-error-p (setq sel (vl-catch-all-apply 'ssget cmd_lst))) 
    (setvar "nomutt" 0) 
    (if (and (not sel) (= (logand bits 2) 2)) 
      (setq sel t) 
    ) 
  ) 
  (cond ((not sel) nil) 
        ((= (type sel) 'pickset) 
         (if (= (logand bits 14) 0)
           (ssname sel 0) 
           sel 
         ) 
        ) 
        ((= (type sel) 'vl-catch-all-apply-error) (princ (vl-catch-all-error-message sel)) nil) 
        (t nil) 
  ) 
)
(defun lib:conv-pickset-to-list (value / item lst)
       (repeat (setq item (sslength value)) ;_ end setq
         (setq lst (cons (ssname value (setq item (1- item))) lst))
         ) ;_ end repeat

  lst
;;;  (if selset 
;;;    (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))) 
;;;    )
  ) ;_ end of defun 
;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;; http://forum.dwg.ru/showthread.php?t=51822
;;--------------------------------------------------------
(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 24.08.2012 в 17:24.
VVA вне форума  
 
Непрочитано 24.08.2012, 17:29
#155
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,641


Уважаемый VVA, вы мастер лиспописания и и к тому же программного полезабивания в таблицы автокада.. А не могли бы вы сочинить лисп, принудительно обновляющий поля в таблице?
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума  
 
Непрочитано 24.08.2012, 19:58
#156
VVA

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


?
Код:
[Выделить все]
(command "_updatefield" "_all" "")
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 24.08.2012, 21:00
#157
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,641


Цитата:
Сообщение от VVA Посмотреть сообщение
?
Код:
[Выделить все]
(command "_updatefield" "_all" "")
Ежели б усе было так просто.. Не работает, зараза, "апдейтофилд все"! По непонятной причине перестают обновляться поля в таблицах, обновляются только при заходе в ячейку, в редактор поля и нажатии кнопки "ОК". Вот я и думаю, может возможно написать код, "симулирующий" это действие?
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума  
 
Непрочитано 25.08.2012, 02:55
#158
Largo GT

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


Цитата:
Сообщение от VVA Посмотреть сообщение
Тестируй. Можно группировать, можно выбирать рамкой/секрамкой
Предыдущие здесь
Код:
[Выделить все]
(defun C:ATTSS ( / en obj tblobj row col lst pt rows cols what fld str ss *error*)
;;;;  Команда: ATTSS (AREA To Table with Sum and Select)
;;;;  posted http://forum.dwg.ru/showthread.php?p=962978#post962978
;;;; Владимир Азарко (VVA) для www.dwg.ru
;;;; Вариант с суммированием, где при суммировании или вычитании используется выбор объектов ssget'ом.
;;;; Это дает возможность выбирать рамкой, секрамкой или группой, если объеты предварительно сруппировать командой _GROUP
;;;;  и включить группировку. Переменная PICKSTYLE=1 или сочетание клавиш CTRL+H
;;;;  Эта команда позволяет вставлять начиная с указанной ячейки таблицы
;;;;  текст с полем (FIELD), содержащее значение площади выбранного контура.
;;;;  В зависимости от выбора, навигация по таблице идет по строкам или столбцам.
;;;;  Если строки или столбцы заканчиваются, то они автоматически добавляются.
;;;;  Форматирование ячейки берется как у первой указанной.
;;;;  Точность округления и масштабный коэффициент настраиваются через опцию Установки
;;;;  Так как это поле связано с конкретным объектом, то при изменении
;;;;  объекта поле пересчитывается (необходимо обновление поля)
;;;;  Код можно сохранить в файле attss.lsp
;;;;  Возможный макрос для кнопки или пункта меню:
;;;;  ^C^C(if (not C:ATTSS)(load "ATTSS"));ATTSS;
  (vl-load-com)
(defun *error* (msg)(while (> (getvar "CMDACTIVE") 0) (command))
 (princ message)(princ))
  (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
       ((and (member en '("+" "-"))
             (setq ss (mip-ssentget-by-type (strcat (if (= en "+") "СУММИРОВАНИЕ > " "ВЫЧИТАНИЕ > ") "Выбери полилинию") '("LWPOLYLINE" "CIRCLE") 14))
             )
	(setq str en fld "%<\\AcExpr (" lst (lib:conv-pickset-to-list ss))
        (foreach en lst
	  (if (vlax-property-available-p (setq en (vlax-ename->vla-object en)) 'Area)
	    (progn
	      (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)) (mapcar 'vlax-ename->vla-object 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)
)
(defun mip-ssentget-by-type (msg types bits / sel cmd_lst) 
;;; 
;;; Параметры: 
;;; msg - краткое приглашение для выбора, допускается NIL 
;;; bits - целое от 0 до 15, битовый переключатель, значения битов: 
;;;    1 - разрешение выбора на заблокированном слое 
;;;    2 - разрешение многократного выбора 
;;;    4 - разрешение выбора рамкой / секрамкой 
;;;    8 - возвращать набор 
;;; types - список имен допустимых типов примитивов, допускается NIL 
;;; 
;;; Пример: 
;;; (mip-ssentget-by-type "Выбери отрезок или полилинию" '("LINE" "LWPOLYLINE") 14) 
;;; 
;;; Возвращает имя _первого_ примитива из попавших в набор, при удачном выборе 
;;; или NIL при отказе с помощью Enter или прерывании по Esc, в последнем случае, 
;;; одновременно выводит сообщение о прерывании в командную строку. 
;;; 
;;; При наличииии любого из битов: 2, 4 или 8 и при успешном выборе, возвращает 
;;; не имя примитива, а набор. 
;;; 
  (setq msg     (strcat "\n" 
                        (if msg 
                          (strcat msg " ") 
                          "" 
                        ) 
                        (if (= (strcase (getvar "SYSCODEPAGE")) "ANSI_1251") 
                          "<Выход>" 
                          "<Exit>" 
                        ) 
                ) 
        cmd_lst (if (= (logand bits 2) 0) 
                  ":S" 
                  "" 
                ) 
        cmd_lst (if (= (logand bits 4) 0) 
                  (strcat cmd_lst ":E") 
                  cmd_lst 
                ) 
        cmd_lst (if (= (logand bits 1) 0) 
                  (strcat cmd_lst ":L") 
                  cmd_lst 
                ) 
        cmd_lst (if (/= cmd_lst "") 
                  (list (strcat "_" cmd_lst)) 
                ) 
        types   (mapcar (function (lambda (x) (cons 0 x))) types) 
  ) 
  (if (and types (> (length types) 1)) 
    (setq types (append (cons '(-4 . "<OR") types) '((-4 . "OR>")))) 
  ) 
  (if types 
    (setq cmd_lst (append cmd_lst (list types))) 
  ) 
  (setvar "ERRNO" 0) 
  (while (and (/= (getvar "ERRNO") 52) (not sel)) 
    (princ msg) 
    (setvar "nomutt" 1) 
    (vl-catch-all-error-p (setq sel (vl-catch-all-apply 'ssget cmd_lst))) 
    (setvar "nomutt" 0) 
    (if (and (not sel) (= (logand bits 2) 2)) 
      (setq sel t) 
    ) 
  ) 
  (cond ((not sel) nil) 
        ((= (type sel) 'pickset) 
         (if (= (logand bits 14) 0)
           (ssname sel 0) 
           sel 
         ) 
        ) 
        ((= (type sel) 'vl-catch-all-apply-error) (princ (vl-catch-all-error-message sel)) nil) 
        (t nil) 
  ) 
)
(defun lib:conv-pickset-to-list (value / item lst)
       (repeat (setq item (sslength value)) ;_ end setq
         (setq lst (cons (ssname value (setq item (1- item))) lst))
         ) ;_ end repeat

  lst
;;;  (if selset 
;;;    (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))) 
;;;    )
  ) ;_ end of defun 
;;--------------------------------------------------------
;; Функция получает строковое представление 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)
     )
  )
)
у меня абракадабра :

Код:
[Выделить все]
Команда: ATTSS

Текущий масштаб = 1 Текущая точность 
округления = 2 Высота текста = 280.0 Префикс=  
Суффикс=  Р*азделитель=точка
Таблиц не найдено!

Команда:
ACA 2012 x64 rus sp2
Largo GT вне форума  
 
Непрочитано 25.08.2012, 08:45
#159
VVA

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


AlexV, покажи файл, а так же расскажи про автокад и винду поподробнее
>Largo GT такое бывает, когда копируешь код при текущей английской раскладке.
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 25.08.2012 в 08:51.
VVA вне форума  
 
Непрочитано 25.08.2012, 09:38
#160
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,641


Цитата:
Сообщение от VVA Посмотреть сообщение
AlexV, покажи файл, а так же расскажи про автокад и винду поподробнее
>Largo GT такое бывает, когда копируешь код при текущей английской раскладке.
Винда "7" 64 бит, иногда работаю под виртуалкой "win xp-mode". Автокад 2012 + SPDS CS (сборка 7.1.1064), - но та же ерунда бывала и на других версиях (2010, 2011). Глюк не постоянный, в новом файле обычно все окей. Когда возникает, с чем связан, - не знаю.. Вроде связан с файлом, а не компом, - на других открываешь файл, - глюк остается.
Вложения
Тип файла: dwg
DWG 2010
_пример.dwg (139.8 Кб, 4033 просмотров)
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума  
 
Непрочитано 25.08.2012, 15:20
#161
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,762


Offtop:
Цитата:
Сообщение от AlexV Посмотреть сообщение
глюк остается.
Меньше в чате сидеть надо.....
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
 
Непрочитано 27.08.2012, 08:36
#162
Nata1

Инженер
 
Регистрация: 10.11.2008
Владимирская обл., пос. Вольгинский
Сообщений: 147


Цитата:
Сообщение от VVA Посмотреть сообщение
Тестируй. Можно группировать, можно выбирать рамкой/секрамкой
VVA, КЛАСС и СУПЕР! Огромное СПАСИБО! Перейду с AREATT-а на ATTSS.
__________________
AutoCAD 2014
Nata1 вне форума  
 
Непрочитано 27.08.2012, 15:09
#163
VVA

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


>Nata1 На здоровье
>AlexV, Глюк подтверждаю. Как побороть - не знаю. Правильнее, наверное, так
Цитата:
Сообщение от AlexV Посмотреть сообщение
По непонятной причине перестают обновляться поля формулы в таблицах
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.08.2012, 16:23
#164
AlexV

Инженер
 
Регистрация: 02.10.2008
С-Пб
Сообщений: 3,641


Цитата:
Сообщение от VVA Посмотреть сообщение
>Nata1 На здоровье
>AlexV, Глюк подтверждаю. Как побороть - не знаю. Правильнее, наверное, так
Ну, не обязательно кстати сказать формулы. Поля в ячейках со ссылкой к примеру на свойства чертежа, - тоже перестают обновляться. Причем совершенно непредсказуемо иногда файл "вылечивается", - но ненадолго. Предпологал, что це могло быть связано с использованием vba, - у меня таблицы спецификации и ВРС считаются автоматом, - может "objtabl.RegenerateTableSuppressed = True.... objtabl.RegenerateTableSuppressed = False" как-то "портят" таблицу. Но никакой прямой связи нет, после работы макроса все может быть окей, а через какое то время - бац, и перестали обновляться.. Запарило однако это дело, уж сколько раз замазывал в выдаваемых комплектах шифры, даты, фамилии и т.д., - из-за глюков этих с полями.
__________________
...Не пытайся гнуть ты ложку,
Не вяжи её узлом.
Ложка - ложка понарошку,
А по правде, - это лом!
AlexV вне форума  
 
Непрочитано 25.04.2013, 17:53
#165
Garand


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


Изменил для себя код из поста #2, сделал извлечение не площади, а длины.
Не получилось сделать повтор запроса при невыборе объекта, если объект не указан, программа прекращает выполняться.
И нельзя ли сделать еще записывание также в ячейки содержимого мулитьвыноски, причем циклом, перед извлечением длины полилинии?
Т.е. первый клик -на мультивыноску - содержимое в ячейку, второй клик на полилинию - длину в соседнюю (или еще лучше, указанную заранее другую) ячейку, с перемещением также по строкам.
Garand вне форума  
 
Непрочитано 30.07.2013, 17:38
#166
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


Уважаемые форумчане! Не могли бы вы переделать код из#1, чтобы указывая на текст или мтекст в таблицу вставлялось поле со значением этого текста, и что бы можно было задавать шаг вставки через одну ячейку, две.... И т.д.
И еще подскажите код для автоматической нумерации, сначала программа спросила скакого номера начинать затем тыкаю куданибудь и появляется текст с номером
Виталий Владимирович К вне форума  
 
Непрочитано 30.07.2013, 17:49
#167
Агент СмиТ

Gti
 
Регистрация: 14.01.2010
МО Железнодорожный
Сообщений: 121


Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
И еще подскажите код для автоматической нумерации, сначала программа спросила скакого номера начинать затем тыкаю куданибудь и появляется текст с номером
Попробуй это
__________________
Каждая система стремится к равновесию.
Агент СмиТ вне форума  
 
Непрочитано 03.08.2013, 18:05
#168
VVA

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


Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
важаемые форумчане! Не могли бы вы переделать код из#1, чтобы указывая на текст или мтекст в таблицу вставлялось поле со значением этого текста,
Виталий Владимирович К, Посмотри варианты, начиная с #2

Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
и что бы можно было задавать шаг вставки через одну ячейку, две.... И т.д
В том же #2 найди в коде
Код:
[Выделить все]
...(1+ col) ... (1+ row)...
и замени на нужное
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 16.08.2013, 10:45
#169
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


Попытался переделать lisp, но чего то не получается выдает ошибку. Может кто-нибудь исправит
Код:
[Выделить все]
 					;  Команда: TEST 
					;  posted http://dwg.ru/f/showthread.php?t=14528


(defun C:MAREATT (/ en obj tblobj row col lst pt rows cols what fld ss)
  (vl-load-com)
  (or *SCALE* (setq *SCALE* 1))
  (or *PREC* (setq *PREC* 2))
  (or *TEXTSIZE* (setq *TEXTSIZE* (getvar "TEXTSIZE")))
  (princ "\nТекущий масштаб = ")
  (princ *SCALE*)
  (princ " Текущая точность округления = ")
  (princ *PREC*)
  (princ " Высота текста = ")
  (princ *TEXTSIZE*)
  (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)
	   )
	   (initget
	     "Row Col Setting стРоки сТолбцы Установки _Row Col Setting Row Col Setting"
	   )
	 )
	 t
       )
       (or what (setq what "Col"))
       (or
	 (while	(null tblobj)
	   (initget 1)
	   (setq pt (getpoint "\nУкажите ячейку таблицы:"))
	   (mapcar
	     '(lambda (x)
		(or tblobj
		    (and
		      (= :vlax-true
			 (vla-HitTest
			   x
			   (vlax-3d-point (trans pt 1 0))
			   (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
			   'row
			   'col
			 )
		      )
		      (setq tblobj x)
		    )
		)
	      )
	     lst
	   )
	   (if (null tblobj)
	     (princ " ** мимо **")
	   )
	 )
	 t
       )
       (or
	 (vlax-write-enabled-p tblobj)
	 (and
	   (princ "\nТаблица на заблокированном слое!")
	   nil
	 )
       )
       (setq pt (vla-GetCellAlignment tblobj row col))
     )
     (setq rows (vla-get-rows tblobj))
     (setq cols (vla-get-columns tblobj))
     (princ
       "\nВыберите текст для вставки его значения в таблицу (ENTER — завершение): "
     )
     (setq ss (ssget))
     (while (and ss (> (sslength ss) 0) (setq en (ssname ss 0)))
       (cond
	 ((vlax-property-available-p (setq en (vlax-ename->vla-object en)) TextString)
	    (setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa id) ">%).TextString>%"))
		(vl-princ-to-string (Get-ObjectID-x86-x64 en))
		   ""TextString""
			)
		 ;_ 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Для этого примитива невозможно получить значие TextString!"
	  )
	 )
       )
       (ssdel (ssname ss 0) ss)
     )
    )
    (t
     (princ "\nТаблиц не найдено!")
    )
  )
  (princ)
)

;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/foru...sageID=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)
    )
  )
)

Последний раз редактировалось Кулик Алексей aka kpblc, 12.08.2014 в 12:02.
Виталий Владимирович К вне форума  
 
Непрочитано 16.08.2013, 20:27
#170
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,550


чо за бред?
gomer вне форума  
 
Непрочитано 19.08.2013, 15:34
#171
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


Цитата:
Сообщение от VVA Посмотреть сообщение
В том же #2 найди в коде

Код:

[Выделить все]
...(1+ col) ... (1+ row)...

и замени на нужное
Получилось поменять значение площади на содержимое текста, но ни как неполучается сделать так, чтобы значения в таблице записывались через одну ячейку. Может кто- нибудь подскажет?
Виталий Владимирович К вне форума  
 
Непрочитано 21.08.2013, 15:38
#172
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,762


Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
через одну ячейку.
Цитата:
(setq col (1+ col))
(setq row (1+ row))
Тута правь...
Вас там еще не полностью затопило????
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
 
Непрочитано 21.08.2013, 16:19
#173
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


Затопило сильно, неделю назад на вертолете летел на вахту подчти через всю область, если не река разлилась то просто озера на полях из- за дождей образовались, все лето дожди идут. Сейчас погода установилась, реки начались спадать. Спасибо за ответ. Где почитать про "col and row". В книге Полищука нету описания этих функций?
Виталий Владимирович К вне форума  
 
Непрочитано 21.08.2013, 16:36
#174
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,762


Дык ты просто по играй с значениями...
(setq col (ХХХХХ+ col))
(setq row (ХХХХХ+ row))
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
 
Непрочитано 21.08.2013, 17:29
#175
Агент СмиТ

Gti
 
Регистрация: 14.01.2010
МО Железнодорожный
Сообщений: 121


Offtop:
Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
Затопило сильно...
Приамурье, держитесь!!!
__________________
Каждая система стремится к равновесию.
Агент СмиТ вне форума  
 
Непрочитано 22.08.2013, 03:20
#176
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


(vla-GetRowHeight tblobj (1- row)) 2)- разобрался, цифра выделенная красным добавляет количество строк в таблице, если она закончилась.
(setq row (1+ row))- заполняет значениями каждую строку, меняю на 2-ошибка.Помогите.

Последний раз редактировалось Виталий Владимирович К, 22.08.2013 в 03:26.
Виталий Владимирович К вне форума  
 
Непрочитано 22.08.2013, 08:32
#177
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,146


Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
(setq row (1+ row))- заполняет значениями каждую строку, меняю на 2-ошибка.Помогите.
А так:
Код:
[Выделить все]
 (setq col (+ 2 col) row (+ 2 row))
?
Лентяй вне форума  
 
Непрочитано 22.08.2013, 09:12
#178
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


Цитата:
Сообщение от Лентяй Посмотреть сообщение
1(setq col (+ 2 col) row (+ 2 row))
По строкам вставляет одно поле, по столбцам вставляет через одну ячейку но по диагонали, а надо по вертикали
Виталий Владимирович К вне форума  
 
Непрочитано 22.08.2013, 09:31
#179
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,762


Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
По строкам вставляет одно поле, по столбцам вставляет через одну ячейку но по диагонали, а надо по вертикали
НУ тебе же намекнули...
Цитата:
(if (= what "Col")(setq col (+ 2 col))(setq row (1+ row)))
Я долго разбирался потому как для меня давно уже не очевидно
Цитата:
(setq col (+ 2 col))
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
 
Непрочитано 22.08.2013, 10:06
#180
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


Всем большое спасибо заработало
Вложения
Тип файла: lsp areatt.LSP (6.0 Кб, 109 просмотров)

Последний раз редактировалось Виталий Владимирович К, 22.08.2013 в 10:15. Причина: Разобрался с лиспом
Виталий Владимирович К вне форума  
 
Непрочитано 22.08.2013, 11:40
#181
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,762


Виталий Владимирович К
С вас фото разлива Амура и затопления Владимировки
__________________
Шаг 12й......
Мои публикации
DEM вне форума  
 
Непрочитано 22.08.2013, 12:50
#182
Виталий Владимирович К

Маркшейдер, геодезист
 
Регистрация: 09.07.2013
Благовещенск, Амурская область
Сообщений: 10


Чего то не получается прикрепить фотографии.

Последний раз редактировалось Виталий Владимирович К, 23.08.2013 в 03:04.
Виталий Владимирович К вне форума  
 
Непрочитано 15.01.2014, 16:37
#183
A.Hillys


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


Цитата:
Сообщение от Виталий Владимирович К Посмотреть сообщение
Получилось поменять значение площади на содержимое текста....
Каким образом? Код предоставите?
A.Hillys вне форума  
 
Непрочитано 24.01.2014, 10:35
1 | #184
A.Hillys


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


Также получилось поменять значение площади на длину, и на содержимое текста. Не получилось - на содержимое атрибутов блока.
Подскажите, как это реализовать?
A.Hillys вне форума  
 
Непрочитано 07.08.2014, 20:13 Площадь блока
#185
peacemaker_kiss


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


Что же получается lisp`ом нельзя померить площадь блока! А если скажем есть фасад, который внутри блока отрисован в определенном масштабе, имеет определенное имя и нужна его площадь в ячейки таблицы
peacemaker_kiss вне форума  
 
Непрочитано 07.08.2014, 20:38
#186
Кулик Алексей aka kpblc
Moderator

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


Загоняем в блок точку и отрезок. Какая площадь будет у этого блока?
peacemaker_kiss, создай штриховку и бери ее площадь.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 07.08.2014, 20:41 Штриховка блока
#187
peacemaker_kiss


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


Так то да, но как заштриховать теперь блок, который имеет форму статуи свободы скажем
peacemaker_kiss вне форума  
 
Непрочитано 07.08.2014, 20:43
#188
Кулик Алексей aka kpblc
Moderator

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


О, еще и трехмерку сюда же? peacemaker_kiss, определи сначала задачу, а потом уже и решения искать надо.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 07.08.2014, 20:43 Очнулся
#189
peacemaker_kiss


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


Все сработает конечно через штриховку

----- добавлено через ~3 мин. -----
теперь буду пробовать писать код, чтобы лисп искал блок штриховал его считал площадь штриховки, заносил в таблицу и удалял штриховку. От души спасибо, ибо начинающий кодописец, сидел ломал голову, что с блоком сделать, а решение элементарное
peacemaker_kiss вне форума  
 
Непрочитано 11.08.2014, 19:36 Не считает, подлец, ошибку выдает!
#190
peacemaker_kiss


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


Не знаешь почему?
Миниатюры
Нажмите на изображение для увеличения
Название: Безымянный.png
Просмотров: 86
Размер:	94.1 Кб
ID:	133467  
peacemaker_kiss вне форума  
 
Непрочитано 11.08.2014, 19:53
#191
Кулик Алексей aka kpblc
Moderator

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


К кому обращение? И "почему" что?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.08.2014, 11:59 Обращение к тебе!
#192
peacemaker_kiss


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


Почему автокад не показывает площадь штриховки???
peacemaker_kiss вне форума  
 
Непрочитано 12.08.2014, 12:01
#193
Кулик Алексей aka kpblc
Moderator

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


Так, файл нужен
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.08.2014, 12:02 Слово то слово
#194
peacemaker_kiss


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