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

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

LISP. Выравнивание текста по двум точкам.

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 28.02.2009, 12:59 1 | #1
LISP. Выравнивание текста по двум точкам.
Krieger
 
инженер (КМ)
 
Красноярск
Регистрация: 30.10.2004
Сообщений: 3,729

Krieger вне форума Вставить имя

Внесу и я свой скромный вклад в этот раздел. Программа для выравнивания текста относительно двух указанных точек. Используется для простановки текста в центре чего либо. Например если это прямоугольник, нужно указать его диагональ, а потом текст. Текст переместится в центр прямоугольника, а его выравнивание установится как MiddleCenter. Или установка текста над/под линией по центру с указанным отступом. Выровняв текст по линии есть возможность его сместить вдоль этой линии не прерывая функцию, выбрав соответствующую опцию. Точки можно как указывать так и вычислить указав просто отрезок или сегмент полилинии (с дуговыми сегментами не работает). Функция работает с аннотативными объектами, причем смещение от линии каждого аннотативного представления текста зависит от его масштаба. Игнорирует аннотативный масштаб если не установлен текущим аннотативный размерный стиль.
Функция назначает тексту указанный в параметрах слой. Никакие опции слоя не устанавливаются.

Использовать функцию (Kr_AligmentTextLine a An Justify layer), здесь
а - величина смещения текста над линией
An - угол в градусах в пользовательской системе координат или "ang" - угол по линии
Justify - выравнивание текста для Mtext/Text:
0 - BottomCenter
1 - MiddleCenter
2 - TopCenter
layer - слой для текста, nil - не менять слой

например
(Kr_AligmentTextLine 2 "ang" 0 "Текст") ;над линией в слой "Текст"
(Kr_AligmentTextLine 0 0 1 "Текст") ;просто в центр в слой "Текст"
(Kr_AligmentTextLine -2 "ang" 2 nil) ;под линию, слой не меняется
(Kr_AligmentTextLine 0 30 1 (getvar "Clayer")) ;в центр, с фиксированным углом 30 градусов в UCS, в текущий слой


Код:
[Выделить все]
;|
Функция Kr_AligmentTextLine
*** Автор Морозов С.В. aka Krieger ***
Выравнивает Mtext и Text относительно двух точек.
Особенности:
Отступ от линии (параметр "a") умножается на коэффициент масштаба, который принимается в зависимости от переменной dimscale,
текущего пространства, активного видового экрана, текущего размерного стиля, масштаба аннотаций. См. Kr_ScaleOfVP.
Таким образом для каждого аннотативного представления смещение будет различным.
Аннотативный масштаб учитывается только если установлен текущим аннотативный размерный стиль.
При последующем смещении текста по линии, перемещаются все представления. Чтобы этого не было, нужно перемещать "в ручную" за ручки.
Параметры
а - величина смещения текста над линией
An - угол в градусах в пользовательской системе координат или "ang" - угол по линии
Justify - выравнивание текста для Mtext/Text:
    0 - BottomCenter
    1 - MiddleCenter
    2 - TopCenter
layer - слой для текста
    
Примеры:
(Kr_AligmentTextLine 2 "ang" 0 "Текст") ;над линией в слой "Текст"
(Kr_AligmentTextLine 0 0 1 "Текст") ;просто в центр в слой "Текст"
(Kr_AligmentTextLine -2 "ang" 2 nil) ;под линию, слой не меняется
(Kr_AligmentTextLine 0 30 1 (getvar "Clayer")) ;в центр, с фиксированным углом 30 градусов в UCS, в текущий слой

Использует функции:
Kr-AligmentTextLine
Kr_entsel
Kr_ScaleOfVP
Kr_AnnoScaleList
|;

(defun Kr_AligmentTextLine (a An Justify layer / p1 p2 key1 key2 ent vl-ent)
  (vl-load-com)
(setq   key1 T
      ent nil)
(while key1
  (setq key2 T)
    (while key1
      (if ent
        (progn
          (initget 128 "Переместить Move _Move Move")
          (setq promt "\nНачальная точка отрезка для выравнивания текста [Переместить последний (Move last)] <Указать отрезок>:")
        (if (= (type p1) 'LIST) (setq pp1 p1))
            );progn
        (setq promt "\nНачальная точка отрезка для выравнивания текста <Указать отрезок>:")
        );if
      
      (if (setq p1 (getpoint promt))
        (if (eq p1 "Move") (Kr-MoveText pp1 p2 ent)
          
        (if (setq p2 (getpoint p1 "\nКонечная точка отрезка для выравнивания текста <Повторить ввод первой точки>:"))
          (progn
        (setq key2 nil)
        (if (setq ent (Kr_entsel "\nВыберите текст для выравнивания <Указать заново точки>" '("TEXT" "MTEXT") nil))
          (progn
              (if (setq AnnoScaleList (Kr_AnnoScaleList ent))
                (progn
                  (setq CurentAnnoScale (getvar "CANNOSCALE"))
                    (foreach n AnnoScaleList
                      (setvar "CANNOSCALE" n)
                      (Kr-AligmentText (* a (Kr_ScaleOfVP)) An Justify p1 p2 (vlax-ename->vla-object ent))
                      )
                  (setvar "CANNOSCALE" CurentAnnoScale)
                  );progn
                (Kr-AligmentText (* a (Kr_ScaleOfVP)) An Justify p1 p2 (vlax-ename->vla-object ent))
                );if
            (if layer
                (vla-put-layer (vlax-ename->vla-object ent)
              (vla-get-name (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-Acad-Object))) layer)))
              );if
            );progn
          );if
          );progn
          (setq key1 T
            key2 T)
          );if
          
        );if                                                            
        (setq key1 nil
          key2 T)
       );if

      );while
;
  
    (while key2
      
       (if ent
        (progn
          (initget 128 "Переместить Move Точки Point _Move Move Point Point")
          (setq promt "\nВыберите отрезок или сегмент полилинии [Переместить последний (Move last)/указать Tочки (specify Point)] <Выход>:")
        (if (= (type p1) 'LIST) (setq pp1 p1))
            );progn
         (progn
           (initget 128 "Точки Point _Point Point")
        (setq promt "\nВыберите отрезок или сегмент полилинии [Tочки (Point)] <Выход>")
           );progn
        );if
       
      (if (setq p1 (Kr_entsel promt '("LINE" "LWPOLYLINE") nil))
          (if (eq p1 "Point");если указано ключевое слово, key2 завершит этот цикл, а key1 начнет заново первый
            ;                        
            (setq key1 T
              key2 nil)
            (if (eq p1 "Move") (Kr-MoveText pp1 p2 ent)
            ;                        
             (progn
                   (setq vl-ent (vlax-ename->vla-object p1))
            (cond ((eq (vla-get-ObjectName vl-ent) "AcDbPolyline");если выбрана полилиния
                  (setq    p1 (vlax-curve-getclosestpointto vl-ent (trans (getvar "Lastpoint") 1 0))
                    par (vlax-curve-getParamAtPoint vl-ent p1)
                    p1 (trans (vlax-curve-getPointAtParam vl-ent (fix par)) 0 1)
                    p2 (trans (vlax-curve-getPointAtParam vl-ent (1+ (fix par))) 0 1)
                  );setq определили координаты сегмента
                   )
                  ((eq (vla-get-ObjectName vl-ent) "AcDbLine");если выбран отрезок
                       (setq p1 (trans (vlax-safearray->list (vlax-variant-value (vla-get-StartPoint vl-ent))) 0 1)
                      p2 (trans (vlax-safearray->list (vlax-variant-value (vla-get-EndPoint vl-ent))) 0 1)
                );setq
                   )
             );cond
                  
              
              (if (setq ent (Kr_entsel "\nВыберите текст для выравнивания <Указать отрезок>" '("TEXT" "MTEXT") nil))
            (progn
                  (if (setq AnnoScaleList (Kr_AnnoScaleList ent))
                    (progn
                      (setq CurentAnnoScale (getvar "CANNOSCALE"))
                        (foreach n AnnoScaleList
                          (setvar "CANNOSCALE" n)
                          (Kr-AligmentText (* a (Kr_ScaleOfVP)) An Justify p1 p2 (vlax-ename->vla-object ent))
                          )
                      (setvar "CANNOSCALE" CurentAnnoScale)
                      );progn
                        (Kr-AligmentText (* a (Kr_ScaleOfVP)) An Justify p1 p2 (vlax-ename->vla-object ent))
                    );if
              (if layer
                  (vla-put-layer (vlax-ename->vla-object ent)
              (vla-get-name (vla-add (vla-get-layers (vla-get-ActiveDocument (vlax-get-Acad-Object))) layer)))
                );if
              );progn
            );if
             );progn
            );if
          );if
      
            (setq key2 nil
              key1 nil)
      );if

      );while
  );while
  );defun
  
  ;|
Функция Kr_AligmentTextLine
*** Автор Морозов С.В. aka Krieger ***
Выравнивает Mtext и Text относительно двух точек
Параметры
а - величина смещения текста над линией
An - угол в градусах или "ang" - угол по линии
Justify - выравнивание текста для Mtext/Text:
    0 - BottomCenter
    1 - MiddleCenter
    2 - TopCenter
Примеры:
(Kr_AligmentTextLine (* 2 (Kr_ScaleOfVP)) "ang" 0) ;над линией
(Kr_AligmentTextLine 0 0 1) ;просто в центр
(Kr_AligmentTextLine (* -2 (Kr_ScaleOfVP)) "ang" 2) ;под линию
(Kr_AligmentTextLine 0 30 1) ;в центр, с фиксированным углом 30 градусов
|;

(defun Kr-AligmentText (a An Justify p1 p2 vl-ent / UL UL2 pt2 An2)
            (setq     UL1 (angle P1 P2)
            p1 (trans p1 1 0)
            p2 (trans p2 1 0)
            UL2 (angle P1 P2)
            pt2 (polar (polar P1 (angle P1 P2) (/ (distance P1 P2) 2))
                   (+ (* (/ 90.0 180.0) pi)
                      (angle p1 p2))
                   a))
          
        (cond
          ((eq (vla-get-ObjectName vl-ent) "AcDbMText");если Mtext
            (cond
              ((= Justify 0) (vla-put-AttachmentPoint  vl-ent acAttachmentPointBottomCenter))
              ((= Justify 1) (vla-put-AttachmentPoint  vl-ent acAttachmentPointMiddleCenter))
              ((= Justify 2) (vla-put-AttachmentPoint  vl-ent acAttachmentPointTopCenter))
              )
           
        (if (or (eq (type An) 'INT)
            (eq (type An) 'REAL))
          (setq An2 (* (/ An 180.0) pi))
          (setq An2 UL1))
           
           (vla-put-InsertionPoint vl-ent (vlax-3D-point pt2))
           (vla-put-Rotation vl-ent An2)
           );cond
          ((eq (vla-get-ObjectName vl-ent) "AcDbText");если Text
            (cond
              ((= Justify 0) (vla-put-Alignment vl-ent acAlignmentBottomCenter))
              ((= Justify 1) (vla-put-Alignment vl-ent acAlignmentMiddleCenter))
              ((= Justify 2) (vla-put-Alignment vl-ent acAlignmentTopCenter))
              )
           
        (if (or (eq (type An) 'INT)
            (eq (type An) 'REAL))
          (setq An2 (+ (* (/ An 180.0) pi) (- UL2 UL1)))
          (setq An2 UL2))
           
           (vla-put-TextAlignmentPoint vl-ent (vlax-3D-point pt2))
           (vla-put-Rotation vl-ent An2)
           );
          );cond
  );defun
  
  ;|---------------------------------------------------------------
Функция Kr_ScaleOfVP
-----------------------------------------------------------------
*** Автор Морозов С.В. aka Krieger ***
Вычисляет масштаб в зависимоти от переменной dimscale или CANNOSCALEVALUE, если dimscale=0 коэф-т = 1 или относительно vport
|;
(defun Kr_ScaleOfVP ( / dsc)
  ;если текущим установлен аннотативный размерный стиль, масштаб берем с аннотативного масштаба
  (if (= (getvar "dimanno") 1)
    (setq dsc (/ 1 (getvar "CANNOSCALEVALUE")))
    (progn
  ;если dimscale=0 принимаем dsc=1, если нет dsc=dimscale
              (if (= (getvar "dimscale") 0) (setq dsc 1) (setq dsc (getvar "dimscale")))
  ;если мы находимся в пространстве листа:
            (if (= (Getvar "TILEMODE") 0)
  ;если видовое окно не ативно dsc=1, если активно, то берем масштаб с видового экрана
              (if (= (Getvar "CVPORT") 1)
                (setq dsc 1)
                (setq dsc (/ 1 (vla-get-CustomScale (vla-get-ActivePViewport (vla-get-ActiveDocument (vlax-get-Acad-Object))))))
              );if
             );if
      );progn
    );if
    dsc
    )
    
;|
Kr-MoveText
*** Автор Морозов С.В. aka Krieger ***
Функция визуального перемщения текста по линии указанной двумя точками
Параметры:
    p1 - начальная точка для ориентации прямой смещения
    p2 - конечная точка для ориентации прямой смещения
    ent - entity name смещаемого текста
Примеры:
(Kr-MoveText (setq p1 (getpoint)) (getpoint p1) (car (entsel "\nВыбери текст")))

|;
(defun Kr-MoveText (p1 p2 ent / SysList pt3 SysList *error*)
  
  (defun *error* (msg);на всякий пожарный, хотя не должна срабатывать
    (while (> (getvar "CMDACTIVE") 0) (command));сбрасываем активную команду
    (vl-cmdf "_ucs" "_Previous");восстанавливаем ucs    
    (foreach n SysList (setvar (car n) (cadr n)));восстанавливаем переменные
    (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)));закрываем метку отмены
    (Princ "\nЕсли Вы видите этот текст, сообщите разработчику при каких обстоятельствах так получилось");если будет это, значит сработала *error*
    (Princ msg)
    )

  (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)));метка начала отмены
  (cond ((eq (cdr (assoc 0 (entget ent))) "MTEXT") (setq pt2 (cdr (assoc 10 (entget ent)))) )
    ((eq (cdr (assoc 0 (entget ent))) "TEXT") (setq pt2 (cdr (assoc 11 (entget ent)))) )
    );cond
  (setq SysList '();обнуляем SysList
    p1 (trans p1 1 0)
    p2 (trans p2 1 0)
    pt3 (inters p1 p2 pt2 (polar pt2 (+ (angle p1 p2) (* 0.5 pi)) 1) nil));находим точку на линии
  (foreach n (list "AUTOSNAP" "ORTHOMODE" "UCSICON" "CMDECHO")
    (setq SysList (append SysList (list (list n (getvar n)))));запоминаем переменные в список
    );foreach
 
  (vl-cmdf "_ucs" 3 "_none" (trans p1 0 1) "_none" (trans p2 0 1) "");ставим ucs по линии
  (command)
  (setvar "ORTHOMODE" 1) (setvar "UCSICON" 0) (setvar "CMDECHO" 0);устанавливаем нужные переменные
  (princ "\nУкажите смещение")
  (vl-cmdf "_move" ent "" "_none" (trans pt3 0 1) pause)
  (command)
  (if (equal (getvar "LASTPOINT") (trans pt3 0 1) 0.00000001) (vl-cmdf "undo" 1));если указана опция Displacement (ПКМ) отменим это дело
  (vl-cmdf "_ucs" "_Previous");восстанавливаем ucs
  (foreach n SysList (setvar (car n) (cadr n)));восстанавливаем переменные
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)));метка конца отмены
  );defun
  
  ;|Функция Kr_entsel
*** Автор Морозов С.В. aka Krieger ***
Еденичный выбор объекта, замена функции entsel
Возвращает entity name выбранного примитива или nil, точку указки запоминает в переменной LASTPOINT
Параметры:
promt - предложение выбрать объект (string)
filter - фильтр объектов для выбора вида '("LINE" "LWPOLYLINE")
entlist - список примитивов которые не надо выбирать (либо список entity name, либо PICKSET)

Примеры:
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") nil)
(Kr_entsel "\nВыберите объекты" nil nil)
(setq aa nil) (Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a)))))
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (ssget))

|;

(defun Kr_entsel (promt filter entlist / key n newentlist ent_point promt)
  
  (setq key T n 0 newentlist nil)
  (if (eq (type entlist) 'PICKSET)
    (progn
        (while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
        (setq entlist newentlist)
    );progn
   );if
    (while key
        (if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
          (if (or (eq (type ent_point) 'LIST) (not ent_point))
          (if ent_point
            (if (member (setq ent (car ent_point)) entlist)
              (princ "\nПримитив уже выбран")
              (if filter
                  (if (not (member (cdr (assoc 0 (entget ent))) filter))
                (progn (setq str "\nНе верный выбор, выберите: ")
                  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
                );progn
                (setq key nil)
                  );if
                (setq key nil)
            );if
            );if
            (setq key T)
          );if
            (setq key nil)
        );if
      (setq key nil)
          );if
     );while
  (if (eq (type ent_point) 'LIST)
    (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
    ent_point
  );if
);defun

;|Kr_AnnoScaleList
*** Автор Морозов С.В. aka Krieger ***
За код спасибо Makswell
Функция возвращает список масштабов аннотативных представлений примитива.
Параметры
ent - enity name

Пример:
(Kr_AnnoScaleList (car (entsel)))
|;
(defun Kr_AnnoScaleList (ent / lst)
  (if (and (eq (car (car (cdr (assoc -3 (entget ent '("*")))))) "AcadAnnotative") (assoc 360 (entget ent)))
    (progn
      (setq lst nil)
      (foreach n
        (vl-remove-if-not
          '(lambda (x) (= (car x) 350))
          (entget (cdr (assoc 350
          (entget (cdr (assoc 360
                (entget (cdr (assoc 360 (entget ent))))
                  );assoc
               );cdr
              );entget
                  );assoc
               );cdr
              );entget
          );vl-remove-if-not
          (setq lst (append lst (list (cdr (assoc 300 (entget (cdr (assoc 340 (entget (cdr n))))))))))
        );foreach
      lst
      );progn
    nil
    );if
  );defun
Коментарии приветсвуются, в том числе и о грамотности самого кода, так как, для меня это учебный код в котором я пытался хоть как-то освоить этот ActiveX. Кое до чего так и не смог докопаться...

Вложения
Тип файла: lsp Kr_AligmentTextLine.lsp (13.6 Кб, 660 просмотров)

__________________
Делай хорошо, плохо само получится.

Последний раз редактировалось Krieger, 21.12.2010 в 15:54.
Просмотров: 12170
 
Непрочитано 04.05.2010, 13:58
#2
dextron3

Фотограф
 
Регистрация: 01.01.2007
Алматы
Сообщений: 5,005


Хотел поинтересоваться у меня разбросаны тексты по оси Y можно ли их выровнять, на определенный отерзок, при том чтобы X остался тем же, и чтобы выбор происходил не по одному тексту а сразу прямоугольным выделением?
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 04.05.2010, 14:20
#3
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,729


Эта прога так не делает. Надо другую писать.
__________________
Делай хорошо, плохо само получится.
Krieger вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 04.05.2010, 14:40
#4
Хмурый


 
Регистрация: 29.10.2004
СПб
Сообщений: 15,625


dextron3, команда torient из Express Tools
Хмурый вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 04.05.2010, 14:57
#5
dextron3

Фотограф
 
Регистрация: 01.01.2007
Алматы
Сообщений: 5,005


Хмурый, из веткада редактор текста оказывается делает тоже
__________________
инженер проектировшик с опттом программа авто гад образование высшие
dextron3 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 21.12.2010, 12:27 LISP Выравнивание текста по двум точкам
#6
GregoryofYardale

Россия
 
Регистрация: 18.10.2010
Россия
Сообщений: 6
Отправить сообщение для GregoryofYardale с помощью ICQ


ето точно круто
GregoryofYardale вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.02.2011, 17:46
#7
Vadikene

Проектирование дорог
 
Регистрация: 11.01.2010
Таллинн
Сообщений: 12


Не могу понять, что нужно написать в командной строке, что бы вызвать данную функцию
Vadikene вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 16.02.2011, 18:37
#8
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,729


Цитата:
Сообщение от Vadikene Посмотреть сообщение
Не могу понять, что нужно написать в командной строке, что бы вызвать данную функцию
Ну там же примеры есть:
Цитата:
например
(Kr_AligmentTextLine 2 "ang" 0 "Текст") ;над линией в слой "Текст"
(Kr_AligmentTextLine 0 0 1 "Текст") ;просто в центр в слой "Текст"
(Kr_AligmentTextLine -2 "ang" 2 nil) ;под линию, слой не меняется
(Kr_AligmentTextLine 0 30 1 (getvar "Clayer")) ;в центр, с фиксированным углом 30 градусов в UCS, в текущий слой
Как использовать лисп
__________________
Делай хорошо, плохо само получится.
Krieger вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 27.10.2011, 05:50
#9
Maremarsik


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


подскажите пожалуйста как этот лисп превратить в кнопочку на панели, потому что вручную очень долго команду вводить...
и еще: я так понял, возможности ориентировать текст относительно углов прямоугольника, в который мы его вставляем - нет? т.е. чтоб строго параллельно его стороне.
Maremarsik вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 27.10.2011, 06:29
#10
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,729


Цитата:
Сообщение от Maremarsik Посмотреть сообщение
подскажите пожалуйста как этот лисп превратить в кнопочку на панели, потому что вручную очень долго команду вводить...
и еще: я так понял, возможности ориентировать текст относительно углов прямоугольника, в который мы его вставляем - нет? т.е. чтоб строго параллельно его стороне.
Пост №8.
Т.е. этот макрос нужно прописать в свойствах кнопки, и все, например этот: (Kr_AligmentTextLine 2 "ang" 0 "Текст")

http://www.youtube.com/watch?v=WLKdGD0wiMI&hd=1
__________________
Делай хорошо, плохо само получится.
Krieger вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 24.12.2011, 16:02
#11
GRIFEL

пенсионер-конструктор
 
Регистрация: 11.02.2011
Калуга
Сообщений: 68


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

(DEFUN C:BT(/ ca ee e h a m m1 d k)
(command"_.ucs""_v")
(setq e(car(entsel"\n ВЫБЕРИ ТЕКСТ :"))ee(entget e)ca'((k)(cdr(assoc k ee))) m(ca 10)H(CA 40)a(ca 1)
M1(getcorner M" ЗОНА РАЗМЕЩЕНИЯ :" )D(-(cadr M1)(cadr M))M1(LIST(car M1)(cadr M)0))
(entdel E)(command "_.TEXT" "_a" m M1 a)(SETQ E(ENTLAST)EE(ENTGET E)H(CA 40))
(setq ee(subst(cons 41(/ h d))(assoc 41 ee)ee))(entmod ee)(princ))
GRIFEL вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Готовые программы > LISP. Выравнивание текста по двум точкам.

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

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

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

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 261 04.05.2018 12:45
Выравнивание текста при распечатке BudYa AutoCAD 19 15.10.2008 11:04
Выравнивание текста pasha_1977 AutoCAD 6 31.07.2007 13:03
Изменение форматированного текста посредством lisp Tramp LISP 4 03.03.2006 11:28
LISP бы для текста Dym LISP 13 01.12.2005 22:32

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