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

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

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

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