[staer]

Интересует как можно через вба в автокаде сделать автозамену. Для примера в ворде это выглядит так:
Sub Макрос1()
W.Selection.Find.ClearFormatting()
W.Selection.Find.Replacement.ClearFormatting()
With W.Selection.Find
.Text = 111
.Replacement.Text = 222
.Forward = True
.Wrap = wdFindContinue
End With
W.Selection.Find.Execute(Replace:=wdReplaceAll)
End Sub

[Сергей Богатов]

Тут не так...
Смотри:
AcadSelectionSet
AcadText
AcadMtext
Ну и если нужно в атрибутах блоков и в табличках ковыряться то ещё и всё связанное с ними.
Вобщем просмотри сначала объектную модель... Мне кажется в downloade есть куча всяких макросов - поковыряйся в них

[hwd]

Здесь и на VBA примеры есть (в самом низу, помечены как "VBA/ActiveX Code Reference") по подразделам пробегись, выбери нужное тебе.

[staer]

Спасибо.
П.С. но для себя что пока изучать программирование, что бы написать такую простую программку не рентабельно, проще заплатить программисту Пойду в раздел поиск исполнителей

[hwd]

если в кодописательстве не силён, то чем не устроила стандартная команда _find?

[gomer]

staer, так подойдет?

Код:

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

 (defun c:replacestr (/ ss i oldstr newstr)
  (vl-load-com)
  (if (and (setq oldstr (getstring T "\nСтарый текст: "))
	   (setq newstr (getstring T "\nНовый текст: "))
	   (setq ss (ssget (list '(0 . "*TEXT"))))
      )
    (progn
      (vla-StartUndoMark
	(setq i	   0
	      adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	)
      )
      (repeat (sslength ss)
	(while
	  (wcmatch (vla-get-TextString
		     (setq
		       en
			(vlax-ename->vla-object (ssname ss i))
		     )
		   )
		   (strcat "*" oldstr "*")
	  )
	   (vla-put-TextString
	     en
	     (vl-string-subst newstr oldstr (vla-get-TextString en))
	   )
	)
	(setq i (1+ i))
      )
      (vla-EndUndoMark Adoc)
    )
  )
)

хоть и не vba, но работает

[staer]

gomer, а что это? LISP?

[Дима_]

Сообщение от staer gomer, а что это? LISP?

Offtop: Вот это самый мощный вопрос в разделе программирование
Это язык программирования, диалект которого встроен в автокад (самый первый и существует до сих пор - в отличие от VBA, которого уже там, но опционально загрузить еще можно).

[gomer]

Сообщение от staer что это? LISP?

ага... vba, я не спец... но надеюсь разберешься... и еще... на форуме caduser.ru - целая ветка про VBA... там помогут быстрее...
код #6 я писал минут 10... с оговорками он рабочий... просто, я не понимаю, чем хуже стандартный _.find

[staer]

gomer спасибо попробую там тоже задать этот вопрос. А лиспом я просто вообще не пользовался, попробовал открыть редактор лисп, открыл новый файл, вставил туда твой код, а дальше как его запустить?
Вообще моя цель запустить все это из VB 2010, так что бы забивал новый текст, который необходимо исправить и он открывал все файлы по всем разделам производил автозамену, переводил в пдф, сохранял и закрывал. С вордовскими файлами у меня все работает, осталось разобраться с автокадовскими...

[gomer]

Сообщение от staer как его запустить?

Ctrl+Alt+E в лисп редакоре
это загрузить
replacestr ввести в командной строке + Enter
это запустить

[staer]

Сообщение от gomer Ctrl+Alt+E в лисп редакоре это загрузить replacestr ввести в командной строке + Enter это запустить

По нажатию Ctrl+Alt+E в лисп редакоре выдает:
_$
; ошибка: слишком много аргументов: (IF (AND (SETQ OLDSTR (GETSTRING T "111")) 4 (SETQ NEWSTR (GETSTRING T "222")) 5 (SETQ SS (SSGET (LIST (QUOTE (0 . "*TEXT"))))) 6) 7 (PROGN 8 (VLA-STARTUNDOMARK 9 (SETQ I 0 10 ADOC (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)) 11) 12) 13 (REPEAT (SSLENGTH SS) 14 (WHILE 15 (WCMATCH (VLA-GET-TEXTSTRING 16 (SETQ 17 EN 18 (VLAX-ENAME->VLA-OBJECT (SSNAME SS I)) 19) 20) 21 (STRCAT "*" OLDSTR "*") 22) 23 (VLA-PUT-TEXTSTRING 24 EN 25 (VL-STRING-SUBST NEWSTR OLDSTR (VLA-GET-TEXTSTRING EN)) 26) 27) 28 (SETQ I (1+ I)) 29) 30 (VLA-ENDUNDOMARK ADOC) 31) 32)
_$

а на replacestr пишет что такой команды не существует...

[gomer]

Сообщение от staer По нажатию Ctrl+Alt+E в лисп редакоре выдает

Нажми здесь на коде белый листик с синими квадратными скобочками, и скопируй текст из окошечка

[staer]

gomer, спс все заработало) но только там есть одно но, что необходимо выбирать текст вручную объекты в которых нужно заменить, а нужно что бы он сразу менял во всем чертеже автоматически.
П.С. gomer, а ты сможешь написать программку, разумеется за деньги, что бы она делала то же самое как я описал для вордовских файлов, желательно на VB2010?

[Дима_]

Сообщение от staer а нужно что бы он сразу менял во всем чертеже автоматически

Если во всем четреже - подразумевается во всей модели - то замени строку (setq ss (ssget (list '(0 . "*TEXT")))) на (setq ss (ssget "_a" (list '(0 . "*TEXT")))), если чтоб еще в листах, блоках и т.д. - надо "поколдовать" побольше (хотя подобные темы с реализациями уже точно были).

[staer]

Дима__ спасибо, работает. да конечно надо еще и в листах и в блоках.
Но вообще я хотел сделать это все на VBA что бы потом перенести в VB2010, откуда я смогу производить автозамену сразу в нескольких файлах. А в данном варианте пока что практической пользы нет, т.к. это всего лишь заменяет стандартную автозамену...

[gomer]

ну, ну... в принципе и лиспом такие задачи и лиспом решаются

[TararykovDG]

staer, попробуй так. Заменит указанный текст во всех файлах в указанной папке(только в самой папке, но не во вложенных)

Код:

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

 
; Вызов: Replace-Text
(defun c:Replace-Text()
  (vl-load-com)
  ((lambda(old_txt)
     (if (not (vl-catch-all-error-p old_txt))
       ((lambda(new_txt)
          (if (not (vl-catch-all-error-p new_txt))
            (progn
              (replace_txt old_txt new_txt (Directory-Dia "Укажите папку: "))
              (alert "Замена текста завершена!!!")
              )
            )
          )
         (vl-catch-all-apply 'getstring
                             (list t "\nВведите новый текст: ")
                             )
         )
       )
     )
    (vl-catch-all-apply 'getstring
                        (list t "\nВведите старый текст: ")
                        )
    )
  (princ)
  ); end c:Replace-Text


(defun replace_txt(old_txt new_txt path_folder / lst_files path_file odbx ent index)
  (setq index 1)
  (if path_folder
    (if (setq lst_files (mapcar '(lambda (x) (strcat path_folder x)) (vl-directory-files path_folder "*.dwg" 1)))
      (foreach path_file lst_files
        (setvar "MODEMACRO" (strcat "Всего файлов: " (itoa (length lst_files)) "     Обработано: " (itoa index) "     Текущий файл: " path_file))
        (if (setq odbx (_lispru-odbx))
          (progn
            (vla-open odbx path_file)
            (vlax-for ent (vla-get-ModelSpace odbx)
              (cond ((or (= (vla-get-objectname ent) "AcDbMText")
                         (= (vla-get-objectname ent) "AcDbText")
                         )
                     (vla-put-TextString ent (vl-string-subst-all (vla-get-TextString ent) new_txt old_txt))
                     )
                    ((eq "AcDbBlockReference" (vla-get-objectname ent))
                     (if (> (vlax-safearray-get-u-bound (vlax-variant-value (vla-GetAttributes ent)) 1) -1)
                       (foreach attr (vlax-safearray->list (vlax-variant-value (vla-GetAttributes ent)))
                         (vla-put-TextString attr (vl-string-subst-all (vla-get-TextString attr) new_txt old_txt))
                         )
                       )
                     )
                    )
              )
            (vla-saveas odbx path_file)
            (vlax-release-object odbx)
            (setq odbx nil)
            )
          )
        (setq index (1+ index))
        )
      )
    )
  (setvar "MODEMACRO" "")
  ); end replace_txt



;|	Для работы с неактивным документом используется метод ObjectDBX
	http://autolisp.ru/2010/04/08/proceed-unactive-document/
|;
; Функции _lispru-acad-version и _lispru-odbx взяты отсюда http://autolisp.ru/2010/04/08/proceed-unactive-document/
;	Directory-Dia - http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=23&TID=48293&MID=269115#message269115 пост #2


(defun _lispru-acad-version ()	; http://autolisp.ru/2010/04/08/proceed-unactive-document/
;|
*    Возвращает номер сборки AutoCAD'a. Для 2005 вернет 16.1, для 2006 - 16.2
* и т.д.
|;
(atof (getvar "acadver"))
) ;_ end of defun


(defun _lispru-odbx (/)	; http://autolisp.ru/2010/04/08/proceed-unactive-document/
                    ;|
*    функция возвращает интерфейс IAxDbDocument (для работы с файлами DWG без
* их открытия). Если интерфейс не поддерживается, возвращает nil. Проверено
* на ACAD 2002, 2004, 2005, 2006, 2007, 2008, 2010
*    Автор - Fatty aka Олег jr. 
*    Параметры вызова:
* нет
*    Примеры вызова:
(_lispru-odbx)
|;
  (cond
    ((< (_lispru-acad-version) 15.06)
     (alert
       "ObjectDBX method not applicable\nin this AutoCAD version"
       ) ;_ end of KPBLC-MSG-ALERT
     nil
     )
    ((= (fix (_lispru-acad-version)) 15)
     (if (not (vl-registry-read
                "HKEY_CLASSES_ROOT\\ObjectDBX.AxDbDocument\\CLSID"
                ) ;_ end of vl-registry-read
              ) ;_ end of not
       (startapp "regsvr32.exe"
                 (strcat "/s \"" (findfile "axdb15.dll") "\"")
                 ) ;_ end of startapp
       ) ;_ end of if
     (vla-getinterfaceobject
       (vlax-get-acad-object)
       "ObjectDBX.AxDbDocument"
       ) ;_ end of vla-getinterfaceobject
     )
    (t
     (vla-getinterfaceobject
       (vlax-get-acad-object)
       (strcat "ObjectDBX.AxDbDocument." (itoa (fix (_lispru-acad-version))))
       ) ;_ end of vla-getinterfaceobject
     )
    ) ;_ end of cond
) ;_ end of defun


; Исходный код http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=23&TID=48293&MID=269115#message269115 пост #2
(defun Directory-Dia (Message / sh folder folderobject result)
    ;; By Tony Tanzillo
    ;; Modified by Tim Willey
    ;; 16 Will let you type in the path
    ;; 64 Will let you create a new folder
    ;; Use
    ;; (Directory-Dia "Create Sheet Index \nSelect directory to grab Drawings \nBy Tim Willey 09/13/07")

    (setq sh
      (vla-getInterfaceObject
        (vlax-get-acad-object)
        "Shell.Application"
      )
    )
    (setq folder
      (vlax-invoke-method
        sh
        'BrowseForFolder
        (vla-get-HWND (vlax-get-Acad-Object))
        Message
        0 ;;; This is the bit number to change.
               ;;; Вместо 0 можно попробовать (+ 16 64)
		;;; 16 - позволяет набирать путь 
		;;; 64 - позволяет создавать новую папку
	""	; - корневой каталог, не обязательный параметр !!! НЕЛЬЗЯ БУДЕТ ВЕРНУТЬСЯ НА УРОВЕНЬ ВЫШЕ !!!
      )
    )
    (vlax-release-object sh)
    (if   folder
      (progn
   (setq folderobject
          (vlax-get-property folder 'Self)
   )
   (setq result
          (vlax-get-property FolderObject 'Path)
   )
   (vlax-release-object folder)
   (vlax-release-object FolderObject)
   (if (/= (substr result (strlen result)) "\\")
     (setq result (strcat result "\\"))
     result
   )
      )
    )
) ;_ end of defun

; Заменяет в строке str все вхождения подстроки old_ss на подстроку new_ss
(defun vl-string-subst-all(str new_ss old_ss / )
  (while (vl-string-search old_ss str)
    (setq str (vl-string-subst new_ss old_ss str))
    )
  str
  ); end vl-string-subst-all