Команда или макрос для выделения в файле только текста

ct_ycte · 29.08.2007, 13:20

Команда или макрос для выделения в файле только текста.
За ранее спасибо!!!

Хмурый · 29.08.2007, 13:23

_qselect не подойдет? В частности, можно выбрать тексты

Lorens · 29.08.2007, 13:26

выделяешь все нарисованное (написанное) в файле, заходишь в свойства и в свойствах выбераешь TEXT (можно его на отдельный слой закинуть)

RomaV · 29.08.2007, 13:31

Цитата:

Сообщение от Lorens

выделяешь все нарисованное (написанное) в файле, заходишь в свойства и в свойствах выбераешь TEXT (можно его на отдельный слой закинуть)

Прикольно! Не знал такой фишки!

Ещё есть команда SelectSimilar (Выбрать подобное), но я не знаю работает она в голом КАДе.

Кулик Алексей aka kpblc · 29.08.2007, 13:37

Это команда ADT, ее в "чистом" каде нет.

tokhot · Регистрация: 17.11.2004

Цитата:

Сообщение от ct_ycte

Команда или макрос для выделения в файле только текста.
За ранее спасибо!!!

Для выбора TEXT
^C^C(setq a(ssget "_X" '((0 . "TEXT"))));(sssetfirst nil a)

Для выбора MTEXT
^C^C(setq a(ssget "_X" '((0 . "MTEXT"))));(sssetfirst nil a)

Как совместить не знаю.
Пусть поможет Кулик Алексей aka kpblc.

G.A.W. · 29.08.2007, 15:07

Или
Ctrl+A > Быстрый выбор > (дальше по надобности) либо "Текст", либо "МТекст" > Оператор - "Выбрать все" > ОК! - или это не из той оперы?

Кулик Алексей aka kpblc · 29.08.2007, 15:22

> tokhot: нечто типа

Код:

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

(defun c:mysel (/ ss)
  (if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT"))))
    (sssetfirst ss ss)
    ) ;_ end of if
  ) ;_ end of defun

:?:
А если надо еще и RTEXT, например, выделять, то можно так:

Код:

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

(defun c:mysel (/ ss)
  (if (setq ss (ssget "_X" '((0 . "*TEXT"))))
    (sssetfirst ss ss)
    ) ;_ end of if
  ) ;_ end of defun

ct_ycte · 29.08.2007, 16:13

Спасибо большое!!!
Всего пару строк а работает как надо!!!
А не подскажешь где можно взять литературу по лиспу и VBA.
Буду очень признателен.

Кулик Алексей aka kpblc · 29.08.2007, 16:21

F1

http://dwg.ru/forum/viewtopic.php?t=110
http://dwg.ru/forum/viewtopic.php?p=16319
http://cad.dp.ua/
Ну и какая-то часть болтается здесь.

ct_ycte · 29.08.2007, 17:35

Привет!!!
А не мог бы объяснить эти две строчки.
(if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT"))))
(sssetfirst ss ss)
Не понятно что такте "_Х".
И даже в справочнике искал назнавение sssetfirst, но не нашол :-(.
За ранее очень признателен!

ct_ycte · 29.08.2007, 18:09

Извини за беспокойство, последний вопрос отпадает. Я нашол.
Но возник новый вопрос .
После того как выделили ТЕКСи МТЕКСТ.
Код:
(defun c:mysel (/ ss)
(if (setq ss (ssget "_X" '((0 . "TEXT,MTEXT"))))
(sssetfirst ss ss)
) ;_ end of if
) ;_ end of defun

Можно сменить так же программым кодом текстовый стиль у выделенного текста? Наверное по отдельности. Сначала у ТЕКСТа потом у МТЕКСТа.

Огурец · 29.08.2007, 18:41

Цитата:

выделяешь все нарисованное (написанное) в файле, заходишь в свойства и в свойствах выбераешь TEXT (можно его на отдельный слой закинуть)

Уважаемый Lorens!

Я раньше не знал такого способа. Очень остроумно. Чтобы не потерялся, Вы напишите сообщение в закреплённую тему http://dwg.ru/forum/viewtopic.php?t=...281850f03307df

VVA · 29.08.2007, 18:55

>ct_ycte
Пробуй так

Код:

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

;Change Text Style 
(defun c:CTS (/ adoc stn tablelist mydcl СhangeAllTextObjectsStyle) 
  (defun tablelist (s / d r) 
    (while (setq d (tblnext s (null d))) 
      (setq r (cons (cdr (assoc 2 d)) r)) 
    )               ;while 
  ) ;_ defun 
  (defun mydcl (zagl info-list / fl ret dcl_id) 
    (vl-load-com) 
    (if   (null zagl) 
      (setq zagl "Выбор") 
    ) ;_ end of if 
    (setq fl (vl-filename-mktemp "mip" nil ".dcl")) 
    (setq ret (open fl "w")) 
    (mapcar 
      '(lambda (x) (write-line x ret)) 
      (list "mip_msg : dialog { " 
       (strcat "label=\"" zagl "\";") 
       " :list_box {" 
       "alignment=top ;" 
       "width=51 ;" 
       (if   (> (length info-list) 26) 
         "height= 26 ;" 
         (strcat "height= " (itoa (+ 3 (length info-list))) ";") 
       ) ;_ end of if 
       "is_tab_stop = false ;" 
       "key = \"info\";}" 
       "ok_cancel;}" 
      ) ;_ end of list 
    ) ;_ end of mapcar 
    (setq ret (close ret)) 
    (if   (and (not (minusp (setq dcl_id (load_dialog fl)))) 
        (new_dialog "mip_msg" dcl_id) 
   ) ;_ and 
      (progn 
   (start_list "info") 
   (mapcar 'add_list info-list) 
   (end_list) 
   (set_tile "info" "0") 
   (setq ret (car info-list)) 
   (action_tile "info" "(setq ret (nth (atoi $value) info-list))") 
   (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))") 
   (action_tile "accept" "(done_dialog 1)") 
   (start_dialog) 
      ) ;_ end of progn 
    ) ;_ end of if 
    (unload_dialog dcl_id) 
    (vl-file-delete fl) 
    ret 
  ) ;_ end of defun 
  ;;Posted by T.Willey 
  ;;http://www.theswamp.org/index.php?topic=14247.15 
  (defun СhangeAllTextObjectsStyle 
    (doc styname / tempobjtype colcnt rowcnt nmbr) 
    (setq nmbr 1.) 
    (vlax-for blk (vla-get-blocks doc) 
      (if (= (vla-get-isxref blk) :vlax-false) 
   (vlax-for obj blk 
     (grtext -2 (strcat "Working " (rtos nmbr 2 0))) 
     (setq tempobjtype (vla-get-objectname obj)) 
     (if (vlax-write-enabled-p obj) 
       (cond 
         ((vl-position 
       tempobjtype 
       '("AcDbText" "AcDbMText" "AcDbAttributeDefinition") 
          ) ;_ end of vl-position 
          (vla-put-stylename obj styname) 
         ) 
         ((wcmatch tempobjtype "AcDb*Dimension") 
          (vla-put-textstyle obj styname) 
         ) 
         ((= tempobjtype "AcDbBlockReference") 
          (foreach   att (vlax-invoke obj 'getattributes) 
       (vla-put-stylename att styname) 
          ) ;_ end of foreach 
          (foreach   att (vlax-invoke obj 'getconstantattributes) 
       (vla-put-stylename att styname) 
          ) ;_ end of foreach 
         ) 
         ((= tempobjtype "AcDbTable") 
          (setq colcnt 0) 
          (repeat (vla-get-columns obj) 
       (setq rowcnt 0) 
       (repeat (vla-get-rows obj) 
         (vlax-invoke 
           obj 'setcelltextstyle rowcnt colcnt styname) ;_ end of vlax-invoke 
         (setq rowcnt (1+ rowcnt)) 
       ) ;_ end of repeat 
       (setq colcnt (1+ colcnt)) 
          ) ;_ end of repeat 
         ) 
       ) ;_ end of cond 
     ) ;_ end of if 
     (setq nmbr (1+ nmbr)) 
   ) ;_ end of vlax-for 
      ) ;_ end of if 
    ) ;_ end of vlax-for 
  ) ;_ end of defun 
  (vl-load-com) 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (if (setq stn   (mydcl "Выберите текстовый стиль" 
             (acad_strlsort (tablelist "STYLE")) 
      ) ;_ end of mydcl 
      ) ;_ end of setq 
    (progn 
      (vla-startundomark adoc) 
      (vl-catch-all-apply 'СhangeAllTextObjectsStyle (list adoc stn)) 
      (vla-endundomark adoc) 
    ) ;_ end of progn 
  ) ;_ end of if 
  (vl-cmdf "_redrawall") 
  (princ) 
) ;_ end of defun 
(princ "\nНаберите CTS в командной строке")

** Исправления 30.08.2007
; ошибка: неверная функция: CHANGEALLTEXTOBJECTSSTYLE

ie.spb · 30.08.2007, 09:14

И после этой программы автокад выдает следующее:
cts ; error: bad function: CHANGEALLTEXTOBJECTSSTYLE

ct_ycte · 30.08.2007, 10:04

Начало хорошее у этой проги.
Показывает список всех тестовых стилей, но выдает ошибку. Я сам ее поправить ну не как не смогу (знаний мало

).
Помогите пожалуйста!!!
Может есть еще какие небудь варианты.

Кулик Алексей aka kpblc · 30.08.2007, 10:08

Еще один вариант:

Код:

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

(defun c:cts2 (/                   *error*             adoc
               layer_lst           text_style          loc:layer-status-save
               loc:layer-status-restore
               )

  (defun *error* (msg)
    (loc:layer-status-restore)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun loc:layer-status-restore ()
    (foreach item layer_lst
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock (car item) (cdr (assoc "lock" item)))
             (vla-put-freeze (car item) (cdr (assoc "freeze" item)))
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun loc:layer-status-save ()
    (vlax-for item (vla-get-layers adoc)
      (setq layer_lst (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  ) ;_ end of cons
                            layer_lst
                            ) ;_ end of cons
            ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (loc:layer-status-save)
  (setq text_style (vla-get-name (vla-get-activetextstyle adoc)))
  (vlax-for blk_def (vla-get-blocks adoc)
    (vlax-for subent blk_def
      (cond
        ((wcmatch (strcase (vla-get-objectname subent) t) "*dimen*")
         (vla-put-textstyle subent text_style)
         )
        ((wcmatch (strcase (vla-get-objectname subent) t) "*text*,*attrib*")
         (vla-put-stylename subent text_style)
         )
        ((wcmatch (strcase (vla-get-objectname subent) t) "*blockref*")
         (if (not (minusp (vlax-safearray-get-u-bound
                            (vlax-variant-value (vla-getattributes subent))
                            1
                            ) ;_ end of vlax-safearray-get-u-bound
                          ) ;_ end of minusp
                  ) ;_ end of not
           (foreach attr (vlax-safearray->list
                           (vlax-variant-value (vla-getattributes subent))
                           ) ;_ end of vlax-safearray->list
             (vla-put-stylename attr text_style)
             ) ;_ end of foreach
           ) ;_ end of if
         (if
           (not (minusp (vlax-safearray-get-u-bound
                          (vlax-variant-value (vla-getconstantattributes subent))
                          1
                          ) ;_ end of vlax-safearray-get-u-bound
                        ) ;_ end of minusp
                ) ;_ end of not
            (foreach attr
                     (vlax-safearray->list
                       (vlax-variant-value (vla-getconstantattributes subent))
                       ) ;_ end of vlax-safearray->list
              (vla-put-stylename attr text_style)
              ) ;_ end of foreach
            ) ;_ end of if
         )
        ) ;_ end of cond
      ) ;_ end of vlax-for
    ) ;_ end of vlax-for
  (loc:layer-status-restore)
  (vla-regen adoc acallviewports)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Выполняет назначение стилей размерам (текстовые стили), одно- и многострочным текстам, атрибутам, блокам с атрибутами. Текстовый стиль берется текущий. Состояние слоев неважно.
P.S. На дин.блоках не проверял. Не тестировалось на файлах с внешними ссылками (возможно, там работать будет некорректно).

ct_ycte · 30.08.2007, 10:20

Класс!!!
Спасибо!!!
Только знаешь (извини за настойчивость)
стиль то меняется на текущий, но свойства (например высота) остается от предыдущего.
А нельзя статически забить в это прогу значения высоты, ширины и т.д. и чтоб это применялось ко всему тексту.
Может просто покажешь куда и как а я по аналоги может и осилю.
За ранее огромное спасибо!!!

Кулик Алексей aka kpblc · 30.08.2007, 10:38

С высотой и прочим...
Высоту откуда брать? Из свойств стиля? А если там установлено 0? Или предлагать?
Ширину-то многострочника сделать не проблема, это (ЯТД) будет нормально, но что такое ширина для атрибута, к примеру - я пас.
"и т.д." - что тут подразумевается?
Для варианта "все забито в лисп" (хотя я бы такое точно не применял):

Код:

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

(defun c:cts3 (/                   *error*             adoc
               layer_lst           text_style          loc:layer-status-save
               loc:layer-status-restore
               )

  (defun *error* (msg)
    (loc:layer-status-restore)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun loc:layer-status-restore ()
    (foreach item layer_lst
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock (car item) (cdr (assoc "lock" item)))
             (vla-put-freeze (car item) (cdr (assoc "freeze" item)))
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun loc:layer-status-save ()
    (vlax-for item (vla-get-layers adoc)
      (setq layer_lst (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  ) ;_ end of cons
                            layer_lst
                            ) ;_ end of cons
            ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (loc:layer-status-save)
  (setq text_style (vla-get-name (vla-get-activetextstyle adoc)))
  (vlax-for blk_def (vla-get-blocks adoc)
    (vlax-for subent blk_def
      ; Назначение высоты текста в 2,5 единицы чертежа
      (vl-catch-all-apply '(lambda () (vla-put-height subent 2.5)))
      (cond
        ((wcmatch (strcase (vla-get-objectname subent) t) "*dimen*")
         (vla-put-textstyle subent text_style)
         )
        ((wcmatch (strcase (vla-get-objectname subent) t) "*mtext*")
         (vla-put-stylename subent text_style)
         (vla-put-width subent 0) ; назначение ширины многострочного текста
         )
        ((wcmatch (strcase (vla-get-objectname subent) t) "*text*,*attrib*")
         (vla-put-stylename subent text_style)
         )
        ((wcmatch (strcase (vla-get-objectname subent) t) "*blockref*")
         (if (not (minusp (vlax-safearray-get-u-bound
                            (vlax-variant-value (vla-getattributes subent))
                            1
                            ) ;_ end of vlax-safearray-get-u-bound
                          ) ;_ end of minusp
                  ) ;_ end of not
           (foreach attr (vlax-safearray->list
                           (vlax-variant-value (vla-getattributes subent))
                           ) ;_ end of vlax-safearray->list
             (vla-put-stylename attr text_style)
             ) ;_ end of foreach
           ) ;_ end of if
         (if
           (not (minusp (vlax-safearray-get-u-bound
                          (vlax-variant-value (vla-getconstantattributes subent))
                          1
                          ) ;_ end of vlax-safearray-get-u-bound
                        ) ;_ end of minusp
                ) ;_ end of not
            (foreach attr
                     (vlax-safearray->list
                       (vlax-variant-value (vla-getconstantattributes subent))
                       ) ;_ end of vlax-safearray->list
              (vla-put-stylename attr text_style)
              ) ;_ end of foreach
            ) ;_ end of if
         )
        ) ;_ end of cond
      ) ;_ end of vlax-for
    ) ;_ end of vlax-for
  (loc:layer-status-restore)
  (vla-regen adoc acallviewports)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Код не тестировал - некогда

Для собственной модификации см.комментарии.

ct_ycte · 30.08.2007, 11:01

В принципе для меня более важно только ТЕКС и МТЕКС.
Помнишь ты дал код как его выделить.
Так что в основном надо сменить шрифт и высоту.
последняя прога которую ты дал она меняет и шрифт и высоту.
Супер!!!
Вопрос. т.е. она все это берет из текушего текстового стиля?
А как сделать текстовый стиль текущим?
С меня точно пивцо!!!

VVA · 30.08.2007, 11:04

Подправил пост 14.
Взял пару ф-ций у Алексея.

Код:

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

;Change Text Style 
(defun c:CTS4 (/ adoc stn tablelist mydcl СhangeAllTextObjectsStyle *error* loc:layer-status-restore loc:layer-status-save txtH txtW txtA lst) 
  (defun *error* (msg)(loc:layer-status-restore)(vla-endundomark adoc)(princ msg)(princ)) ;_ end of defun 
  (defun loc:layer-status-restore () 
    (foreach item layer_lst 
      (if (not (vlax-erased-p (car item))) 
        (vl-catch-all-apply 
          '(lambda () 
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
             (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
             ) ;_ end of lambda 
          ) ;_ end of vl-catch-all-apply 
        ) ;_ end of if 
      ) ;_ end of foreach 
    (setq layer_lst nil) 
    ) ;_ end of defun 

  (defun loc:layer-status-save () 
    (setq layer_lst nil) 
    (vlax-for item (vla-get-layers adoc) 
      (setq layer_lst (cons (list item 
                                  (cons "freeze" (vla-get-freeze item)) 
                                  (cons "lock" (vla-get-lock item)) 
                                  ) ;_ end of cons 
                            layer_lst 
                            ) ;_ end of cons 
            ) ;_ end of setq 
      (vla-put-lock item :vlax-false) 
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))) 
      ) ;_ end of vlax-for 
    ) ;_ end of defun 

     (defun tablelist (s / d r) 
    (while (setq d (tblnext s (null d))) 
      (setq r (cons (cdr (assoc 2 d)) r)) 
    )               ;while 
  ) ;_ defun 
  (defun setHWA ( item ) 
   (if (and (vlax-property-available-p item "Height") 
       (> txtH 1e-3)) 
     (vla-put-Height item txtH) 
     ) 
   (if (vlax-property-available-p item "ScaleFactor") 
     (vla-put-ScaleFactor item txtW) 
     ) 
   (if (vlax-property-available-p item "ObliqueAngle") 
     (vla-put-ObliqueAngle item txtA) 
     ) 
    ) 
  (defun mydcl (zagl info-list / fl ret dcl_id) 
    (vl-load-com) 
    (if   (null zagl) 
      (setq zagl "Выбор") 
    ) ;_ end of if 
    (setq fl (vl-filename-mktemp "mip" nil ".dcl")) 
    (setq ret (open fl "w")) 
    (mapcar 
      '(lambda (x) (write-line x ret)) 
      (list "mip_msg : dialog { " 
       (strcat "label=\"" zagl "\";") 
       " :list_box {" 
       "alignment=top ;" 
       "width=51 ;" 
       (if   (> (length info-list) 26) 
         "height= 26 ;" 
         (strcat "height= " (itoa (+ 3 (length info-list))) ";") 
       ) ;_ end of if 
       "is_tab_stop = false ;" 
       "key = \"info\";}" 
       "ok_cancel;}" 
      ) ;_ end of list 
    ) ;_ end of mapcar 
    (setq ret (close ret)) 
    (if   (and (not (minusp (setq dcl_id (load_dialog fl)))) 
        (new_dialog "mip_msg" dcl_id) 
   ) ;_ and 
      (progn 
   (start_list "info") 
   (mapcar 'add_list info-list) 
   (end_list) 
   (set_tile "info" "0") 
   (setq ret (car info-list)) 
   (action_tile "info" "(setq ret (nth (atoi $value) info-list))") 
   (action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))") 
   (action_tile "accept" "(done_dialog 1)") 
   (start_dialog) 
      ) ;_ end of progn 
    ) ;_ end of if 
    (unload_dialog dcl_id) 
    (vl-file-delete fl) 
    ret 
  ) ;_ end of defun 
  ;;Posted by T.Willey 
  ;;http://www.theswamp.org/index.php?topic=14247.15 
  (defun СhangeAllTextObjectsStyle 
    (doc styname / tempobjtype colcnt rowcnt nmbr) 
    (setq nmbr 1.) 
    (vlax-for blk (vla-get-blocks doc) 
      (if (= (vla-get-isxref blk) :vlax-false) 
   (vlax-for obj blk 
     (grtext -2 (strcat "Working " (rtos nmbr 2 0))) 
     (setq tempobjtype (vla-get-objectname obj)) 
     (if (vlax-write-enabled-p obj) 
       (cond 
         ((vl-position 
       tempobjtype 
       '("AcDbText" "AcDbMText" "AcDbAttributeDefinition") 
          ) ;_ end of vl-position 
          (vla-put-stylename obj styname)(setHWA obj) 
         ) 
         ((wcmatch tempobjtype "AcDb*Dimension") 
          (vla-put-textstyle obj styname)(setHWA obj) 
         ) 
         ((= tempobjtype "AcDbBlockReference") 
          (foreach   att (vlax-invoke obj 'getattributes) 
       (vla-put-stylename att styname)(setHWA att) 
          ) ;_ end of foreach 
          (foreach   att (vlax-invoke obj 'getconstantattributes) 
       (vla-put-stylename att styname)(setHWA att) 
          ) ;_ end of foreach 
         ) 
         ((= tempobjtype "AcDbTable") 
          (setq colcnt 0) 
          (repeat (vla-get-columns obj) 
       (setq rowcnt 0) 
       (repeat (vla-get-rows obj) 
         (vlax-invoke 
           obj 'setcelltextstyle rowcnt colcnt styname) ;_ end of vlax-invoke 
         (setq rowcnt (1+ rowcnt)) 
       ) ;_ end of repeat 
       (setq colcnt (1+ colcnt)) 
          ) ;_ end of repeat 
         ) 
       ) ;_ end of cond 
     ) ;_ end of if 
     (setq nmbr (1+ nmbr)) 
   ) ;_ end of vlax-for 
      ) ;_ end of if 
    ) ;_ end of vlax-for 
  ) ;_ end of defun 
  (vl-load-com) 
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
  (if (and (setq stn   (mydcl "Выберите текстовый стиль" 
             (acad_strlsort (tablelist "STYLE")) 
             ) ;_ end of mydcl 
       ) ;_ end of setq 
      (setq lst (tblsearch "STYLE" stn)) 
      ) 
    (progn 
      (setq txtH (cdr(assoc 40 lst)) ;_Высота текста 
       txtW (cdr (assoc 41 lst));_Степень сжатия-растяжения 
       txtA (cdr(assoc 50 lst)) ;_Угол наклона в радианах 
       ) 
;;; Значения можно задать постоянные. Например 
;;;      (setq txtH 3.5  ;_Высота текста 
;;;          txtW 0.8  ;_Степень сжатия-растяжения 
;;;            txtA 0    ;_Угол наклона в радианах (3.14159 *  (УГОЛ_ГРАДУСЫ / 180.0)) 
;;;      ) 
      
      (vla-startundomark adoc) 
      (loc:layer-status-save) 
      (vl-catch-all-apply 'СhangeAllTextObjectsStyle (list adoc stn)) 
      (loc:layer-status-restore) 
      (vla-endundomark adoc) 
    ) ;_ end of progn 
  ) ;_ end of if 
  (vl-cmdf "_redrawall") 
  (princ) 
) ;_ end of defun 
(princ "\nНаберите CTS4 в командной строке")

Стиль выбирается в диалоговом окне
Текстам, Атрибутам, Размерам назначаестя степень сжатия-растяжения, угол наклона и высота из описания текстового стиля. Если высота в стиле 0, то оставляется текущая.
Вспрочем все это можно забить постоянными цифрами (см. комментарии в коде)

*** PS
Наверное высота текста для размеров из текстового стиля не есть гуд :?:

VVA · 30.08.2007, 11:32

> Кулик Алексей aka kpblc
Пару замечаний по ф-циям loc:layer-status-restore и loc:layer-status-save.
1. Переменную layer_lst в конце loc:layer-status-restore лучше обнулять.
2. loc:layer-status-restore не восстанавливает состояние слоев, т.к.
assoc к сохраняемому элементу списка item [типа (#<VLA-OBJECT IAcadLayer2 023dedc4> ("freeze" . :vlax-false) ("lock" . :vlax-true)) ] дает ошибку.
Правильнее
(vla-put-lock (car item) (cdr (assoc "lock" (CDR item))))

ct_ycte · 30.08.2007, 11:38

Спасибо вам ребята!!!
Вы просто супер!!!
Все, начинаю читать книги по LISP чтоб быть хоть чуть чуть похожим на вас!!!
Огромное спасибо!!!

Кулик Алексей aka kpblc · 30.08.2007, 11:44

> VVA : Осознал

Каюсь и посыпаю головенку пеплом.

Dym · 30.08.2007, 12:19

Цитата:

SelectSimilar (Выбрать подобное)

подозреваю что прикольная штучка, из АДТ её никак в голый кад не вставить?

ct_ycte · 31.08.2007, 17:16

Привет!!!
Крыс подскажи пожалуйста куда и какие строки прописать в твою программу для того чтоб статически прописать шрифт(как и высоту).
Спасибо!!!

Код:

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

(defun c:cts2 (/                   *error*             adoc 
               layer_lst           text_style          loc:layer-status-save 
               loc:layer-status-restore 
               ) 

  (defun *error* (msg) 
    (loc:layer-status-restore) 
    (vla-endundomark adoc) 
    (princ msg) 
    (princ) 
    ) ;_ end of defun 

  (defun loc:layer-status-restore () 
    (foreach item layer_lst 
      (if (not (vlax-erased-p (car item))) 
        (vl-catch-all-apply 
          '(lambda () 
             (vla-put-lock (car item) (cdr (assoc "lock" item))) 
             (vla-put-freeze (car item) (cdr (assoc "freeze" item))) 
             ) ;_ end of lambda 
          ) ;_ end of vl-catch-all-apply 
        ) ;_ end of if 
      ) ;_ end of foreach 
    ) ;_ end of defun 

  (defun loc:layer-status-save () 
    (vlax-for item (vla-get-layers adoc) 
      (setq layer_lst (cons (list item 
                                  (cons "freeze" (vla-get-freeze item)) 
                                  (cons "lock" (vla-get-lock item)) 
                                  ) ;_ end of cons 
                            layer_lst 
                            ) ;_ end of cons 
            ) ;_ end of setq 
      (vla-put-lock item :vlax-false) 
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))) 
      ) ;_ end of vlax-for 
    ) ;_ end of defun 

  (vl-load-com) 
  (vla-startundomark 
    (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
    ) ;_ end of vla-startundomark 
  (loc:layer-status-save) 
  (setq text_style (vla-get-name (vla-get-activetextstyle adoc))) 
  (vlax-for blk_def (vla-get-blocks adoc) 
    (vlax-for subent blk_def 
      (cond 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*dimen*") 
         (vla-put-textstyle subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*text*,*attrib*") 
         (vla-put-stylename subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*blockref*") 
         (if (not (minusp (vlax-safearray-get-u-bound 
                            (vlax-variant-value (vla-getattributes subent)) 
                            1 
                            ) ;_ end of vlax-safearray-get-u-bound 
                          ) ;_ end of minusp 
                  ) ;_ end of not 
           (foreach attr (vlax-safearray->list 
                           (vlax-variant-value (vla-getattributes subent)) 
                           ) ;_ end of vlax-safearray->list 
             (vla-put-stylename attr text_style) 
             ) ;_ end of foreach 
           ) ;_ end of if 
         (if 
           (not (minusp (vlax-safearray-get-u-bound 
                          (vlax-variant-value (vla-getconstantattributes subent)) 
                          1 
                          ) ;_ end of vlax-safearray-get-u-bound 
                        ) ;_ end of minusp 
                ) ;_ end of not 
            (foreach attr 
                     (vlax-safearray->list 
                       (vlax-variant-value (vla-getconstantattributes subent)) 
                       ) ;_ end of vlax-safearray->list 
              (vla-put-stylename attr text_style) 
              ) ;_ end of foreach 
            ) ;_ end of if 
         ) 
        ) ;_ end of cond 
      ) ;_ end of vlax-for 
    ) ;_ end of vlax-for 
  (loc:layer-status-restore) 
  (vla-regen adoc acallviewports) 
  (vla-endundomark adoc) 
  (princ) 
  ) ;_ end of defun

Александр Ривилис · 31.08.2007, 17:35

Цитата:

Сообщение от mitjaj

Цитата:

SelectSimilar (Выбрать подобное)

подозреваю что прикольная штучка, из АДТ её никак в голый кад не вставить?

Возьми здесь: http://www.maestrogroup.com.ua/support/selsim.zip
Загрузишь соответствующую версию:
AutoCAD 2004-2006: SelSim2006.arx
AutoCAD 2007-2008: SelSim2007.arx
Выбираешь примитив(ы) и жмешь правую кнопку мыши (или набираешь _SELSIM в командной строке).

ct_ycte · 31.08.2007, 18:12

Извини даже пробовать не буду.
Мне уже все сделал Кулик Алексей Крыс.
Осталость только шрифт прописать.
Так что буду ждать его ответа.

Александр Ривилис · 31.08.2007, 18:13

Цитата:

Сообщение от ct_ycte

Извини даже пробовать не буду.
Мне уже все сделал Кулик Алексей Крыс.
Осталость только шрифт прописать.
Так что буду ждать его ответа.

А это не тебе - это замена SelectSimilar для чистого AutoCAD.
Кстати зря отказываешься. Для примера выбрал окружность, нажал правую кнопку мыши, выбрал Выбор по образцу и выбрались все окружности на слое указанной окружности. Ну и т.д. Упрощенный и ускоренный Быстрый выбор.

Dym · 31.08.2007, 19:22

ух блин красотища

Александр Ривилис · 31.08.2007, 19:25

Цитата:

Сообщение от mitjaj

ух блин красотища

Уже попробовал? Там есть еще пункт Настройка выбора по образцу - для дополнительной гибкости. И программу достаточно загрузить один раз. При следующих запусках AutoCAD она загружается сама.

Dym · 31.08.2007, 19:30

эт тоже успел, спасибо

в порфель не надо вообще добавлять?

Александр Ривилис · 31.08.2007, 19:34

Цитата:

Сообщение от mitjaj

эт тоже успел, спасибо

в порфель не надо вообще добавлять?

Отлично. В портфель добавлять не нужно - сама грузится.
Кстати если выбираешь, например окружность и отрезок, то она выберет все окружности, лежащие на слое выбранной окружности и все отрезки на слое выбранного отрезка. Ну и т.д. Нет времени писать подробную инструкцию. Ее очень удобно использовать в паре с этой функцией: GeomProps — площадь, длина, объем выбранных примитивов

Dym · 31.08.2007, 19:52

да сегодня просто праздник какой-то

Александр Ривилис · 31.08.2007, 21:24

Цитата:

Сообщение от mitjaj

да сегодня просто праздник какой-то

Поздравляю!

Dym · 31.08.2007, 22:12

selsim в контекстном только настраиваеться, а его запуск оттуда вставить не запарно при случае? настройки и так при активной команде совершить можно

Кулик Алексей aka kpblc · 31.08.2007, 22:16

> ct_ycte : Я код не проверял и не тестировал:

Код:

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

(defun c:cts5 (/
               *error*
               adoc
               layer_lst
               loc:layer-status-save
               loc:layer-status-restore
               text_style_lst
               text_style
               text_height
               )

  (defun *error* (msg)
    (loc:layer-status-restore)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun loc:layer-status-restore ()
    (foreach item layer_lst
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
             (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun loc:layer-status-save ()
    (vlax-for item (vla-get-layers adoc)
      (setq layer_lst (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  ) ;_ end of cons
                            layer_lst
                            ) ;_ end of cons
            ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
      ) ;_ end of vlax-for
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (loc:layer-status-save)
  (setq text_style_lst
         ((lambda (/ res)
            (vlax-for x (vla-get-textstyles adoc)
              (setq res (cons (vla-get-name x) res))
              ) ;_ end of vlax-for
            res
            ) ;_ end of lambda
          )
        ) ;_ end of setq
  (if
    (and
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               '(lambda ()
                  (initget
                    (vl-string-trim
                      " "
                      (apply 'strcat
                             (mapcar '(lambda (x) (strcat x " ")) text_style_lst)
                             ) ;_ end of apply
                      ) ;_ end of vl-string-trim
                    ) ;_ end of initget
                  (setq text_style
                         (cond
                           ((getkword
                              (strcat
                                "\nИмя применяемого стиля ["
                                (vl-string-trim
                                  "/"
                                  (apply 'strcat
                                         (mapcar '(lambda (x) (strcat x "/"))
                                                 text_style_lst
                                                 ) ;_ end of mapcar
                                         ) ;_ end of apply
                                  ) ;_ end of vl-string-trim
                                "] <"
                                (vla-get-name (vla-get-activetextstyle adoc))
                                "> : "
                                ) ;_ end of strcat
                              ) ;_ end of GETKWORD
                            )
                           (t (vla-get-name (vla-get-activetextstyle adoc)))
                           ) ;_ end of cond
                        ) ;_ end of setq
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      text_style
      (not (vl-catch-all-error-p
             (vl-catch-all-apply
               '(lambda ()
                  (setq text_height
                         (getkword
                           (strcat "\nВысота текстов ["
                                   (cond
                                     ((not (equal 0.
                                                  (setq text_height
                                                         (vla-get-height
                                                           (vla-item
                                                             (vla-get-textstyles
                                                               adoc
                                                               ) ; _ end of
                                                                 ; vla-get-TextStyles
                                                             text_style
                                                             ) ; _ end of
                                                               ; vla-item
                                                           ) ; _ end of
                                                             ; vla-get-height
                                                        ) ;_ end of setq
                                                  1e-2
                                                  ) ;_ end of equal
                                           ) ;_ end of not
                                      "2.5"
                                      )
                                     (t (vl-princ-to-string text_height))
                                     ) ;_ end of cond
                                   "/Оставить] <Оставить> : "
                                   ) ;_ end of strcat
                           ) ;_ end of GETKWORD
                        ) ;_ end of setq
                  ) ;_ end of lambda
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      ) ;_ end of and
     (progn
       (setq text_style (vla-item (vla-get-textstyles adoc) text_style))
       (vlax-for blk_def (vla-get-blocks adoc)
         (vlax-for subent blk_def
          ; Назначение высоты текста в 2,5 единицы чертежа
           (if text_height
             (vl-catch-all-apply
               '(lambda () (vla-put-height subent text_height))
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of if
           (cond
             ((wcmatch (strcase (vla-get-objectname subent) t) "*dimen*")
              (vla-put-textstyle subent text_style)
              )
             ((wcmatch (strcase (vla-get-objectname subent) t) "*mtext*")
              (vla-put-stylename subent text_style)
              (vla-put-width subent 0)
          ; назначение ширины многострочного текста
              )
             ((wcmatch (strcase (vla-get-objectname subent) t) "*text*,*attrib*")
              (vla-put-stylename subent text_style)
              )
             ((wcmatch (strcase (vla-get-objectname subent) t) "*blockref*")
              (if (not (minusp (vlax-safearray-get-u-bound
                                 (vlax-variant-value (vla-getattributes subent))
                                 1
                                 ) ;_ end of vlax-safearray-get-u-bound
                               ) ;_ end of minusp
                       ) ;_ end of not
                (foreach attr (vlax-safearray->list
                                (vlax-variant-value (vla-getattributes subent))
                                ) ;_ end of vlax-safearray->list
                  (vla-put-stylename attr text_style)
                  ) ;_ end of foreach
                ) ;_ end of if
              (if
                (not (minusp
                       (vlax-safearray-get-u-bound
                         (vlax-variant-value (vla-getconstantattributes subent))
                         1
                         ) ;_ end of vlax-safearray-get-u-bound
                       ) ;_ end of minusp
                     ) ;_ end of not
                 (foreach attr
                               (vlax-safearray->list
                                 (vlax-variant-value
                                   (vla-getconstantattributes subent)
                                   ) ;_ end of vlax-variant-value
                                 ) ;_ end of vlax-safearray->list
                   (vla-put-stylename attr text_style)
                   ) ;_ end of foreach
                 ) ;_ end of if
              )
             ) ;_ end of cond
           ) ;_ end of vlax-for
         ) ;_ end of vlax-for
       ) ;_ end of progn
     ) ;_ end of if
  (loc:layer-status-restore)
  (vla-regen adoc acallviewports)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Внес (частично) исправления, подсказанные VVA. Может, чего упустил - пишу "на ходу". Поэтому с ним поаккуратнее

Если неверно будет работать - свистни, исправлю(сь).

Александр Ривилис · 01.09.2007, 01:11

Цитата:

Сообщение от mitjaj

selsim в контекстном только настраиваеться, а его запуск оттуда вставить не запарно при случае? настройки и так при активной команде совершить можно

Если я правильно понял о чем ты говоришь, то уже сделал. Скачай по новой и проверь.

Dym · 01.09.2007, 12:43

скачал, так удобнее. разве что б оставить в контекстном только запуск semsil без подменю с целью экономии щелчков и движений мышом. в настройки при запущенной команде два способа попасть вроде достаточно, я так думаю. спасибо

Александр Ривилис · 01.09.2007, 16:37

Цитата:

Сообщение от mitjaj

...разве что б оставить в контекстном только запуск semsil без подменю с целью экономии щелчков и движений мышом...

Так сделать нельзя. Это ограничение этого типа меню в AutoCAD. Увы...

ct_ycte · 02.09.2007, 22:21

Кулик Алексей->
Привет!!!
Да ты тут много что переписал, но если честно меня в полне устраивал предпоследний вариант (он указан ниже).
Только вот если шрифт был TTF то он почему то не менялся на шрифт текущего стиля SHX.
Вот я и подумал что можно добавить пару строк в этот код чтоб шрифт как и высота прописывался статичечки.
Сам пытаюсь найти команды необходимые, пока безрезультатно

Очень тебе благодарен за помощь!!!

Код:

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

(defun c:cts2 (/                   *error*             adoc 
               layer_lst           text_style          loc:layer-status-save 
               loc:layer-status-restore 
               ) 

  (defun *error* (msg) 
    (loc:layer-status-restore) 
    (vla-endundomark adoc) 
    (princ msg) 
    (princ) 
    ) ;_ end of defun 

  (defun loc:layer-status-restore () 
    (foreach item layer_lst 
      (if (not (vlax-erased-p (car item))) 
        (vl-catch-all-apply 
          '(lambda () 
             (vla-put-lock (car item) (cdr (assoc "lock" item))) 
             (vla-put-freeze (car item) (cdr (assoc "freeze" item))) 
             ) ;_ end of lambda 
          ) ;_ end of vl-catch-all-apply 
        ) ;_ end of if 
      ) ;_ end of foreach 
    ) ;_ end of defun 

  (defun loc:layer-status-save () 
    (vlax-for item (vla-get-layers adoc) 
      (setq layer_lst (cons (list item 
                                  (cons "freeze" (vla-get-freeze item)) 
                                  (cons "lock" (vla-get-lock item)) 
                                  ) ;_ end of cons 
                            layer_lst 
                            ) ;_ end of cons 
            ) ;_ end of setq 
      (vla-put-lock item :vlax-false) 
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))) 
      ) ;_ end of vlax-for 
    ) ;_ end of defun 

  (vl-load-com) 
  (vla-startundomark 
    (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
    ) ;_ end of vla-startundomark 
  (loc:layer-status-save) 
  (setq text_style (vla-get-name (vla-get-activetextstyle adoc))) 
  (vlax-for blk_def (vla-get-blocks adoc) 
    (vlax-for subent blk_def 
      (cond 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*dimen*") 
         (vla-put-textstyle subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*text*,*attrib*") 
         (vla-put-stylename subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*blockref*") 
         (if (not (minusp (vlax-safearray-get-u-bound 
                            (vlax-variant-value (vla-getattributes subent)) 
                            1 
                            ) ;_ end of vlax-safearray-get-u-bound 
                          ) ;_ end of minusp 
                  ) ;_ end of not 
           (foreach attr (vlax-safearray->list 
                           (vlax-variant-value (vla-getattributes subent)) 
                           ) ;_ end of vlax-safearray->list 
             (vla-put-stylename attr text_style) 
             ) ;_ end of foreach 
           ) ;_ end of if 
         (if 
           (not (minusp (vlax-safearray-get-u-bound 
                          (vlax-variant-value (vla-getconstantattributes subent)) 
                          1 
                          ) ;_ end of vlax-safearray-get-u-bound 
                        ) ;_ end of minusp 
                ) ;_ end of not 
            (foreach attr 
                     (vlax-safearray->list 
                       (vlax-variant-value (vla-getconstantattributes subent)) 
                       ) ;_ end of vlax-safearray->list 
              (vla-put-stylename attr text_style) 
              ) ;_ end of foreach 
            ) ;_ end of if 
         ) 
        ) ;_ end of cond 
      ) ;_ end of vlax-for 
    ) ;_ end of vlax-for 
  (loc:layer-status-restore) 
  (vla-regen adoc acallviewports) 
  (vla-endundomark adoc) 
  (princ) 
  ) ;_ end of defun

Кулик Алексей aka kpblc · 03.09.2007, 00:10

Ну на самом деле очень мало - если код проанализировать, будет понятно, что много места занимает элементарные вещи - выбор стиля и ввод высоты текста.
А твоя проблема на самом деле намного глубже: в многострочных текстах (прямо внутри каждого объекта) может болтаться собственное форматирование (фонт, наклон текста, высота текста и т.п.). Для этого несколько лиспов болтались. Поиск по "форматир многостр текст" вывел на топики http://dwg.ru/forum/viewtopic.php?p=97727#97727 и http://dwg.ru/forum/viewtopic.php?p=107607#107607 , но какой код там "более рабочий" - сейчас сообразить не могу (второй литр пива все же сказывается).

ct_ycte · 03.09.2007, 13:24

Привет!!! снова я.

Спасибо тебе!!! Вроде нашол подходящую програмку для сброса форматирования многострочного текста.
Алгоритм теперь такой:
Сначала той прогой сбрасываю форматирование
потом прогой (приведена ниже) устанавливаю форматироваание которое необходимо.
Проблема: угол наклона не устанавливается, хотя в текстовом стиле он 15 градусов.
Может его как и высоту статически прописать. И тогда все будет хорошо.
Вся надежда только на тебя!!!

Код:

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

(defun c:cts3 (/                   *error*             adoc 
               layer_lst           text_style          loc:layer-status-save 
               loc:layer-status-restore 
               ) 

  (defun *error* (msg) 
    (loc:layer-status-restore) 
    (vla-endundomark adoc) 
    (princ msg) 
    (princ) 
    ) ;_ end of defun 

  (defun loc:layer-status-restore () 
    (foreach item layer_lst 
      (if (not (vlax-erased-p (car item))) 
        (vl-catch-all-apply 
          '(lambda () 
             (vla-put-lock (car item) (cdr (assoc "lock" item))) 
             (vla-put-freeze (car item) (cdr (assoc "freeze" item))) 
             ) ;_ end of lambda 
          ) ;_ end of vl-catch-all-apply 
        ) ;_ end of if 
      ) ;_ end of foreach 
    ) ;_ end of defun 

  (defun loc:layer-status-save () 
    (vlax-for item (vla-get-layers adoc) 
      (setq layer_lst (cons (list item 
                                  (cons "freeze" (vla-get-freeze item)) 
                                  (cons "lock" (vla-get-lock item)) 
                                  ) ;_ end of cons 
                            layer_lst 
                            ) ;_ end of cons 
            ) ;_ end of setq 
      (vla-put-lock item :vlax-false) 
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))) 
      ) ;_ end of vlax-for 
    ) ;_ end of defun 

  (vl-load-com) 
  (vla-startundomark 
    (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
    ) ;_ end of vla-startundomark 
  (loc:layer-status-save) 
  (setq text_style (vla-get-name (vla-get-activetextstyle adoc))) 
  (vlax-for blk_def (vla-get-blocks adoc) 
    (vlax-for subent blk_def 
      ; Íàçíà÷åíèå âûñîòû òåêñòà â 2,5 åäèíèöû ÷åðòåæà 
      (vl-catch-all-apply '(lambda () (vla-put-height subent 2.5))) 
      (cond 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*dimen*") 
         (vla-put-textstyle subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*mtext*") 
         (vla-put-stylename subent text_style) 
         (vla-put-width subent 0) ; íàçíà÷åíèå øèðèíû ìíîãîñòðî÷íîãî òåêñòà 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*text*,*attrib*") 
         (vla-put-stylename subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*blockref*") 
         (if (not (minusp (vlax-safearray-get-u-bound 
                            (vlax-variant-value (vla-getattributes subent)) 
                            1 
                            ) ;_ end of vlax-safearray-get-u-bound 
                          ) ;_ end of minusp 
                  ) ;_ end of not 
           (foreach attr (vlax-safearray->list 
                           (vlax-variant-value (vla-getattributes subent)) 
                           ) ;_ end of vlax-safearray->list 
             (vla-put-stylename attr text_style) 
             ) ;_ end of foreach 
           ) ;_ end of if 
         (if 
           (not (minusp (vlax-safearray-get-u-bound 
                          (vlax-variant-value (vla-getconstantattributes subent)) 
                          1 
                          ) ;_ end of vlax-safearray-get-u-bound 
                        ) ;_ end of minusp 
                ) ;_ end of not 
            (foreach attr 
                     (vlax-safearray->list 
                       (vlax-variant-value (vla-getconstantattributes subent)) 
                       ) ;_ end of vlax-safearray->list 
              (vla-put-stylename attr text_style) 
              ) ;_ end of foreach 
            ) ;_ end of if 
         ) 
        ) ;_ end of cond 
      ) ;_ end of vlax-for 
    ) ;_ end of vlax-for 
  (loc:layer-status-restore) 
  (vla-regen adoc acallviewports) 
  (vla-endundomark adoc) 
  (princ) 
  ) ;_ end of defun

---
Используй тэги [code] и [/code], вычленить лисп иначе тяжко. kpblc

Кулик Алексей aka kpblc · 03.09.2007, 13:33

Попробую вечером, сейчас шансов нуль

ct_ycte · 03.09.2007, 13:40

Хорошо! Буду ждать!!! Выздоравливай!!!

VVA · 03.09.2007, 14:23

>ct_ycte Пробуй это

Код:

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

(defun c:cts6 (/                   *error*             adoc 
               layer_lst           text_style          loc:layer-status-save 
               loc:layer-status-restore loc:DTR
               loc:mip_MTEXT_Unformat
               textH ;_Высота текста
               textA ;_Угол наклона в градусах
               textW ;_Степень сжатия/растяжения
               ) 

  (defun *error* (msg) 
    (loc:layer-status-restore) 
    (vla-endundomark adoc) 
    (princ msg) 
    (princ) 
    ) ;_ end of defun 
(defun loc:DTR (a)(* pi (/ a 180.0)))
  (defun loc:layer-status-restore () 
    (foreach item layer_lst 
      (if (not (vlax-erased-p (car item))) 
        (vl-catch-all-apply 
          '(lambda () 
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) 
             (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
             ) ;_ end of lambda 
          ) ;_ end of vl-catch-all-apply 
        ) ;_ end of if 
      ) ;_ end of foreach
    (setq layer_lst nil)
    ) ;_ end of defun 

  (defun loc:layer-status-save () 
    (vlax-for item (vla-get-layers adoc) 
      (setq layer_lst (cons (list item 
                                  (cons "freeze" (vla-get-freeze item)) 
                                  (cons "lock" (vla-get-lock item)) 
                                  ) ;_ end of cons 
                            layer_lst 
                            ) ;_ end of cons 
            ) ;_ end of setq 
      (vla-put-lock item :vlax-false) 
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))) 
      ) ;_ end of vlax-for 
    ) ;_ end of defun 
(defun loc:mip_MTEXT_Unformat ( Mtext / text Str )
  (setq Text "")
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or(= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))
	  ))
  Text
  )
  (vl-load-com) 
  (vla-startundomark 
    (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
    ) ;_ end of vla-startundomark
  (setq textH 2.5 ;_Высота текста
        textA 15  ;_Угол наклона в градусах
        textW 1   ;_Степень сжатия/растяжения
        )
  (loc:layer-status-save) 
  (setq text_style (vla-get-name (vla-get-activetextstyle adoc))) 
  (vlax-for blk_def (vla-get-blocks adoc)
    (vlax-for subent blk_def
      (cond 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*dimen*") 
         (vla-put-textstyle subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*mtext*")
         (vla-put-TextString subent
           (strcat "{\\Q"(rtos textA 2 1)";" "\\W"(rtos textW 2 1)";"    
           (loc:mip_MTEXT_Unformat (vla-get-TextString subent))
                   "}"
                   )
           )
         (vla-put-stylename subent text_style) 
         (vla-put-width subent 0) ; iacia?aiea oe?eiu iiiaino?i?iiai oaenoa 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*text*,*attrib*") 
         (vla-put-stylename subent text_style) 
         ) 
        ((wcmatch (strcase (vla-get-objectname subent) t) "*blockref*") 
         (if (not (minusp (vlax-safearray-get-u-bound 
                            (vlax-variant-value (vla-getattributes subent)) 
                            1 
                            ) ;_ end of vlax-safearray-get-u-bound 
                          ) ;_ end of minusp 
                  ) ;_ end of not 
           (foreach attr (vlax-safearray->list 
                           (vlax-variant-value (vla-getattributes subent)) 
                           ) ;_ end of vlax-safearray->list 
             (vla-put-stylename attr text_style) 
             ) ;_ end of foreach 
           ) ;_ end of if 
         (if 
           (not (minusp (vlax-safearray-get-u-bound 
                          (vlax-variant-value (vla-getconstantattributes subent)) 
                          1 
                          ) ;_ end of vlax-safearray-get-u-bound 
                        ) ;_ end of minusp 
                ) ;_ end of not 
            (foreach attr 
                     (vlax-safearray->list 
                       (vlax-variant-value (vla-getconstantattributes subent)) 
                       ) ;_ end of vlax-safearray->list 
              (vla-put-stylename attr text_style) 
              ) ;_ end of foreach 
            ) ;_ end of if 
         ) 
        ) ;_ end of cond
      (vl-catch-all-apply '(lambda ()
        (if (and (vlax-property-available-p subent "Height") 
       (> textH 1e-3))(vla-put-Height subent textH)) 
   (if (vlax-property-available-p subent "ScaleFactor") 
     (vla-put-ScaleFactor subent textW)) 
   (if (vlax-property-available-p subent "ObliqueAngle") 
     (vla-put-ObliqueAngle subent (loc:DTR textA)))))
      ) ;_ end of vlax-for 
    ) ;_ end of vlax-for 
  (loc:layer-status-restore) 
  (vla-regen adoc acallviewports) 
  (vla-endundomark adoc) 
  (princ) 
  ) ;_ end of defun

Форматирование предварительно сносить не нужно, сносится внутри.
Для мтекста угол наклона и степень сжатия задаются тэгами.
Все данные задаются явно. Ищи в тексте

Код:

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

(setq textH 2.5 ;_Высота текста
        textA 15  ;_Угол наклона в градусах
        textW 1   ;_Степень сжатия/растяжения
        )

Стиль назначается текущий

ct_ycte · 06.09.2007, 15:07

Спасибо вам ребята!!!
Благодаря вам решение нашлось!!!

29.08.2007, 13:20		#1
Команда или макрос для выделения в файле только текста ct_ycte Россия Регистрация: 29.08.2007 Сообщений: 28 Команда или макрос для выделения в файле только текста. За ранее спасибо!!!
Просмотров: 10258