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

ct_ycte · 29.08.2007, 13:20

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

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. Увы...

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

	Реклама i