Тема: LISP. Вставка в таблицу/текст поля, соотвествующего длинне примитива
Идея родилась в этой теме
; Команда: DLIT ; Эта команда позволяет вставить в указанную точку рисунка или указанную ячейку таблицы ; текст с полем (FIELD), содержащее значение длинны построенного или выбранного примитива. ; Точность округления и масштабный коэффициент настраиваются через опцию Установки ; Так как это поле связано с конкретным объектом, то при изменении ; объекта поле пересчитывается (необходимо обновление поля) ; Код можно сохранить в файле dlit.lsp ; Возможный макрос для кнопки или пункта меню: ; ^C^C(if (not C:DLIT) (load "dlit"));DLIT; ;_Draw Line and Insert Text (defun C:DLIT ( / en cmdname fld txt fc tblset tblobj row col pt whatAcadVer drawLP ) ;;;Ф-ция возвращает версию Автокада ввиде 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))) ;_darw Line & Polyline (defun drawLP ( cmdname ) (setvar "CMDECHO" 1) (command cmdname) (while (> (getvar "CMDACTIVE") 0)(command pause)) (entlast) ) (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 "Line Polyline Setting sElect Отрезок Полилиния Установки Выбор _Line Polyline Setting sElect Line 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 "Line Polyline Setting sElect Отрезок Полилиния Установки Выбор _Line Polyline Setting sElect Line Polyline Setting sElect") ) t ) ;_ < Запрашиваем что рисовать + опции (cond ((= cmdname "Line")(setq en (drawLP "_.Line"))) ((= cmdname "Polyline")(setq en (drawLP "_.Pline"))) ((or (null cmdname)(= cmdname "sElect")) (princ "\nВыберите отрезок или полилинию") (and (setq tblset (ssget "_:S:E" '((0 . "LINE,*POLYLINE")))) (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 ">%).Length \\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) )
То же самое, но для площади примитива см LISP. Вставка в таблицу поля, соотвествующего площади примитива