Текст из autocad в Word в текущее положение курсора. Как?

_Andre_ · 14.03.2006, 13:52

Делаю первые шаги в связке AutoCAD и WORD. Задача - вставить текст переданный переменной text в активный документ WORD в текущее положение курсора. Пока получилось вот такая функция (часть кода позаимствовал у VK):

Код:

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

(defun ba-text-from-acad-to-word (text / _ba-release-object ActiveDocument msw work_range)
;;;Функция освобождает объект
  (defun _ba-release-object (obj_name /)
    (if	(and obj_name (vlax-object-released-p obj_name))
      (vlax-release-object obj_name)
    ) ;_ end if
    (setq obj_name nil)
  ) ;_ end defun
;;;end of _ba-release-object
  (if (setq msw (vlax-get-or-create-object "Word.Application"))
    (if	(if (vl-catch-all-error-p
	     ;|Пробую узнать активный документ, с отловом ошибкина случай если WORD запушен, но нет открытых документов.|;
	      (setq ActiveDocument
		     (vl-catch-all-apply
		       'vlax-get-property
		       (list msw 'activedocument) ;_ end list
		     ) ;_ end vl-catch-all-apply
	      ) ;_ end setq
	    ) ;_ end vl-catch-all-error-p
	  (setq activedocument nil)
;;;Если вернулась ошибка, то активного док-та нет и функция вернет nil
	  ActiveDocument
;;;Если ошибки не было, то акт. док-т есть, то вернеттся указатель на него.
	) ;_ end if
      (progn (vla-put-visible msw :vlax-true)
;;;Делаем Word видимым
	     (setq work_range (vlax-invoke-method ActiveDocument 'range 0 0))
	     (vlax-invoke-method
	       work_range
	       "insertafter"
	       text ;_ end strcat
	     ) ;_ end vlax-invoke-method
      ) ;_ end progn
      (princ "\nНет активного документа!!!")
    ) ;_ end if
    (princ "\nWORD не запускается!!!")
  ) ;_ end if
  (_ba-release-object work_range)
  (_ba-release-object ActiveDocument)
  (_ba-release-object msw)
)

НО! в таком виде текст вставляется в начало документа, а нужно в текущюю позицию курсора. Подскажите как сделать?
Я так понимаю, что необходимо определить диапазон work_range, при этом привязав его к положению курсора, но как сделать не понимаю =((

vk · 14.03.2006, 15:15

Попробуй в InsertAfter вместо work_range использовать объект Selection.

vk · 14.03.2006, 15:29

В первом приближении получилось так

Код:

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

 ..........
     (progn (vla-put-visible msw :vlax-true) ;_ Делаем Word видимым
        ;; вставка текста в текущую позицию курсора или после выделенного фрагмента
        (vlax-invoke-method (vlax-get-property msw "Selection") "InsertAfter" text)
      ) ;_ end progn
..............

_Andre_ · 14.03.2006, 15:36

VK

Спасибо!

Заработало! [/code]

kminas · 16.03.2006, 22:52

А наоборот из WORD в AutoCAD не можете?

vk · 16.03.2006, 23:35

Цитата:

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

А наоборот из WORD в AutoCAD не можете?

Могем и наоборот.... Тока с таким вот форматированием париться откровенно лень.

_Andre_ · 17.03.2006, 07:34

Для импорта из word в acad сделал вот такую функцию

Код:

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

(defun ba-text-from-word-to-acad (/		  *error*
				  _ba-release-object
				  ActiveDocument  msw
				  work_range	  selection
				  text_list	  text_for_acad
				  text string string_pace ins_point
				 )
  (defun *error* (msg)
    (command)
    (_ba-release-object ActiveDocument)
    (_ba-release-object msw)
    (if	old_cmdecho
      (setvar "cmdecho" old_cmdecho)
    ) ;_ end if
    (princ)
  ) ;_ end defun
;;;Internal function. releases unusing objects.
  (defun _ba-release-object (obj_name /)
    (if	(and obj_name (vlax-object-released-p obj_name))
      (vlax-release-object obj_name)
    ) ;_ end if
    (setq obj_name nil)
  ) ;_ end defun
  ;|Функция заменяет в строке string все встречающие сочетания символов chars_old на chars_new.
Фактически является расширением функции vl-string-subst, которая заменяет только первое попавшееся сочетание
|;
  (defun ba-string-subst (chars_new chars_old string /)
    (setq new_string (vl-string-subst chars_new chars_old string))
    (while (not (equal new_string string))
      (setq string     new_string
	    new_string (vl-string-subst chars_new chars_old string)
      ) ;_ end setq
    ) ;_ end while
    (setq new_string new_string)
  ) ;_ end defun
;;;end of _ba-release-object
;;;  (setq text_list  '("строка номер один" "номер два" "три" "четыре" "пятая"))
;;;to comment after debugging
  (setq old_cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if (setq msw (vlax-get-object "Word.Application"))
    (if ;|this part of code returns active document, if it exists, or nil if not|;
      (if (vl-catch-all-error-p
	   ;|Пробую узнать активный документ, с отловом ошибки. Так как если есть активный документ то вернется указатель на него,
если нет активного, то ошибка и прога прерывается.|;
	    (setq ActiveDocument
		   (vl-catch-all-apply
		     'vlax-get-property
		     (list msw 'activedocument) ;_ end list
		   ) ;_ end vl-catch-all-apply
	    ) ;_ end setq
	  ) ;_ end vl-catch-all-error-p
	(setq activedocument nil)
;;;Если вернулась ошибка, то активного док-та нет и функция вернет nil
	ActiveDocument
;;;Если ошибки не было, то акт. док-т есть, то вернеттся указатель на него.
      ) ;_ end if
       (progn (setq selection (vlax-get-property msw "selection"))
;;;берем то что выделено в документе
	      (setq text (vlax-get-property selection 'text))
	      (setq text_for_acad (ba-string-subst "\\P" "\r" text))
	      (if (setq ins_point (getpoint "\nУкажите точку вставки текста [Выход]:"))
		(if (setq font_height (getreal "\nВведите высоту текста [Выход]"))
		  (if (setq string_pace (getreal "\nВведите шаг строк [Выход]"))
		    (if	(entmake
			  (list	(cons 0 "MTEXT")
				(cons 100 "AcDbEntity")
				(cons 100 "AcDbMText")
				(cons 10 ins_point)
				(cons 41 0)
				(cons 44 string_pace);|[b]Здесь нужно посдтавить выражение параметра межстрочного интервала через высоту шрифта и шага между строк[/b]|;
				(cons 40 font_height)
				(cons 1 text_for_acad)
				(cons 7 (getvar "textstyle"))
			  ) ;_ end list
			) ;_ end entmake
		      (vl-cmdf "_explode" (entlast))
		    ) ;_ end entmake
		  ) ;_ end if
		) ;_ end if
	      ) ;_ end if
       ) ;_ end progn
       (princ
	 "\nВ MS Word нет ни одного открытого документа. \nОткройте документ и попробуйте снова"
       ) ;_ end princ
    ) ;_ end if
    (princ
      "\nMS Word не запущен!!! Запустите MS Word и попробуйте снова"
    ) ;_ end princ
  ) ;_ end if
  (_ba-release-object ActiveDocument)
  (_ba-release-object msw)
  (if old_cmdecho
    (setvar "cmdecho" old_cmdecho)
  ) ;_ end if
  (princ)
)

перед вызовом функции необходимо выделить в Ворде необходимую часть текста.
Никакой специальной борьбы с форматированием не потребовалось, но возможно не попадались такие случаи (какое нибудь сложное форматирование в вордовском тексте например, хотя тестил с разными стилями)

НО! В ФУНКЦИИ ЕСТЬ ОДИН ГЛЮК!!!!

Для простоты текст в autocade сначала создаю как мультитекст, потом разбиваю через _explode.
Но, я так и не понял как связать требуемый шаг в мультитексте между строками (в единицах) с параметром межстрочного интервала (который задается dxf группой 44 в функции entmake).

Подскажите как выразить значение dxf группы 44 c высотой шрифта и шагом между строк ?

p.s. честно изучал хелп - но так и не понял =(

C1 · 17.03.2006, 07:56

Мне кажется в связке AutoCAD - WORD VBA намного удобнее лиспа.

vk · 17.03.2006, 08:37

> _Andre_
Делаю то же самое, но без программы: в Ворде Ctrl+C, затем в АКАДе _.text и на приглашение Enter text: жмакнуть Ctl+V и потом для завершения Enter.
Можно и в окно MTEXT'а - тогда даже сохранится часть форматирования.

PS с "длинными" строками, которые получились из абзацев, все равно воевать придется

_Andre_ · 17.03.2006, 08:52

> vk

Согласен, программа не сильно ускоряет процесс переноса текста =)

Вообщем то основным достоинством как раз и была бы возможность задания межстрочного интервала, но не получается (см вопрос в конце предыдущего моего сообщения).

Лентяй · 17.03.2006, 10:47

Цитата:

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

> vk
Вообщем то основным достоинством как раз и была бы возможность задания межстрочного интервала, но не получается (см вопрос в конце предыдущего моего сообщения).

Все прекрасно решается средствами AcyiveX, о преимуществах которых я уже устал здесь говорить. Ниже - ваша прграмма, исправленная и дополненная. Обратите внимание на объединение некоторых функций в списки.

Код:

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

(defun ba-text-from-word-to-acad (/ *error* _ba-release-object ActiveDocument msw work_range selection
                                  text adoc util ins_point mtext text_prop)
  (setq old_cmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0) 
  (if (setq msw (vlax-get-object "Word.Application"))
    (if (if (vl-catch-all-error-p
              (setq ActiveDocument (vl-catch-all-apply 'vlax-get-property (list msw 'activedocument))));_ end vl-catch-all-error-p
          (setq activedocument nil) ActiveDocument);_ end if
      (progn (setq text (vl-string-subst "\\P" "\r" (vlax-get-property (vlax-get-property msw "selection") 'text))
                   adoc (vla-get-ActiveDocument (vlax-get-acad-object))
                   util (vla-get-utility adoc))
        (mapcar '(lambda (x y) (if (= (getvar "cvport") x) (setq csp (vlax-get-property adoc y))))
          '(2 1 3) '(ModelSpace PaperSpace ModelSpace))                   
        (if (apply 'and (cons (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
                     		(setq ins_point (vla-getPoint util nil "\nУкажите точку вставки текста [Выход]: "))))))
                              (setq text_prop (mapcar '(lambda (x) (vla-getReal util x))
                                '("\nВведите высоту текста [Выход]: " "\nВведите ширину текста [Выход]: " "\nВведите шаг строк [Выход]: ")))));apply
            (setq mtext (vla-addMtext csp ins_point (cadr text_prop) text_for_acad)));if
        (mapcar '(lambda (x y) (vlax-put-property mtext x y))
                   '(Height LineSpacingStyle LineSpacingDistance) (list (car text_prop) 2 (last text_prop)))
      );_ end progn
      (alert "\nВ MS Word нет ни одного открытого документа. \nОткройте документ и попробуйте снова") 
    );_ end if 
    (alert "\nMS Word не запущен!!! Запустите MS Word и попробуйте снова") 
  ) ;_ end if 
  (mapcar 'vlax-release-object (list ActiveDocument adoc msw))
  (if old_cmdecho (setvar "cmdecho" old_cmdecho));_ end if 
  (princ) 
);end

VVA · 17.03.2006, 11:09

А если так

Код:

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

;;;str-строка
;;;pat-разделитель
;;;Запускать:
;;;(setq str "мы;изучаем;рекурсии" pat ";")
;;;(str-str-lst str pat)
;;;Читать http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons
           (substr str 1 i)
           (str-str-lst (substr str (+ 2 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
;;;================================================================================
;;;Функция отключения режима объектной привязки
(defun disable_osmode ()
  (if (and (< (getvar "OSMODE") 16000)
	   (/= (getvar "OSMODE") 0)
	   )
	  (setvar "OSMODE" (+ (getvar "OSMODE") 16384))
	))
;;;================================================================================
;;;Функция включения режима объектной привязки
(defun enable_osmode ()
  (if (> (getvar "OSMODE") 16000)
    (setvar "OSMODE" (- (getvar "OSMODE") 16384))
  ) ;_if
) ;_ End of defun
(defun DTR (a)(* pi (/ a 180.0)))
(defun RTD (a)(/ (* a 180.0) pi))
(defun wr_text (txt t0 h ug vir /)
  ;; Надежно пишет текст txt от точки t0 высотой h угол ug выравнивание vir
  ;; независимо от текущей установки высоты
  ;; Применяется всегда вместо команды _TEXT
  (setq *OSMODE* (getvar "OSMODE"))
  (disable_osmode)
  (if (zerop (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
    (progn
      ;; нулевая высота текста
      (if vir
	(command "_.TEXT" "_J" vir t0 h ug txt)
	(command "_.TEXT" t0 h ug txt)
      ) ;_ end of if
    ) ;_ end of progn
    (progn
      ;; фиксированнная высота
      (if vir
	(command "_.TEXT" "_J" vir t0 ug txt)
	(command "_.TEXT" t0 ug txt)
      ) ;_ end of if
      (vla-put-Height (vlax-ename->vla-object (entlast)) h)
;;;      (izmpole (entget (entlast)) 40 h)
    ) ;_ end of progn
  ) ;_ end of if
  (vla-put-Rotation (vlax-ename->vla-object (entlast)) (dtr ug))
  (setvar "OSMODE" *OSMODE*)
) ;_ end of defun
(defun ba-text-from-word-to-acad (/        *error* 
              _ba-release-object 
              ActiveDocument  msw 
              work_range     selection 
              text_list     text_for_acad 
              text string string_pace ins_point 
             ) 
  (defun *error* (msg) 
    (command) 
    (_ba-release-object ActiveDocument) 
    (_ba-release-object msw) 
    (if   old_cmdecho 
      (setvar "cmdecho" old_cmdecho) 
    ) ;_ end if 
    (princ) 
  ) ;_ end defun 
;;;Internal function. releases unusing objects. 
  (defun _ba-release-object (obj_name /) 
    (if   (and obj_name (vlax-object-released-p obj_name)) 
      (vlax-release-object obj_name) 
    ) ;_ end if 
    (setq obj_name nil) 
  ) ;_ end defun 
  ;|Функция заменяет в строке string все встречающие сочетания символов chars_old на chars_new. 
Фактически является расширением функции vl-string-subst, которая заменяет только первое попавшееся сочетание 
|; 
  (defun ba-string-subst (chars_new chars_old string /) 
    (setq new_string (vl-string-subst chars_new chars_old string)) 
    (while (not (equal new_string string)) 
      (setq string     new_string 
       new_string (vl-string-subst chars_new chars_old string) 
      ) ;_ end setq 
    ) ;_ end while 
    (setq new_string new_string) 
  ) ;_ end defun 
;;;end of _ba-release-object 
;;;  (setq text_list  '("строка номер один" "номер два" "три" "четыре" "пятая")) 
;;;to comment after debugging 
  (setq old_cmdecho (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (if (setq msw (vlax-get-object "Word.Application")) 
    (if ;|this part of code returns active document, if it exists, or nil if not|; 
      (if (vl-catch-all-error-p 
      ;|Пробую узнать активный документ, с отловом ошибки. Так как если есть активный документ то вернется указатель на него, 
если нет активного, то ошибка и прога прерывается.|; 
       (setq ActiveDocument 
         (vl-catch-all-apply 
           'vlax-get-property 
           (list msw 'activedocument) ;_ end list 
         ) ;_ end vl-catch-all-apply 
       ) ;_ end setq 
     ) ;_ end vl-catch-all-error-p 
   (setq activedocument nil) 
;;;Если вернулась ошибка, то активного док-та нет и функция вернет nil 
   ActiveDocument 
;;;Если ошибки не было, то акт. док-т есть, то вернеттся указатель на него. 
      ) ;_ end if 
       (progn (setq selection (vlax-get-property msw "selection")) 
;;;берем то что выделено в документе 
        (setq text (vlax-get-property selection 'text))
	(cond
	  ((= text "\r")
	   (alert "Выделите текст в Worde")
	  )
	  ((and
	     (setq ins_point (getpoint "\nУкажите точку вставки текста [Выход]: "))
	     (not (initget 6)) ;_Запрещаем ввод отрицательных чисел и 0
	     (setq font_height (getreal "\nВведите высоту текста [Выход]: "))
	     (not (initget 2)) ;_Запрещаем ввод 0
	     (setq string_pace (getreal "\nВведите шаг строк [Выход]: "))
	   );_and
	   (setq text_list (str-str-lst text "\r"))
	   (foreach text_line text_list
	     (wr_text text_line ins_point font_height 0 nil)
	     (setq ins_point (polar ins_point (* 1.5 PI) string_pace))
	     )
	   )
	  );_cond
       ) ;_ end progn 
       (alert "\nВ MS Word нет ни одного открытого документа.\nОткройте документ и попробуйте снова")
    ) ;_ end if 
    (alert "\nMS Word не запущен!!!\nЗапустите MS Word и попробуйте снова")
  ) ;_ end if 
  (_ba-release-object ActiveDocument) 
  (_ba-release-object msw) 
  (if old_cmdecho 
    (setvar "cmdecho" old_cmdecho) 
  ) ;_ end if 
  (princ) 
) 
(defun C:TEST ()(ba-text-from-word-to-acad))
(princ "\nНаберите TEST")

Шаг строк отрицательный - текст отрисовывается вверх

kminas · 17.03.2006, 18:41

Цитата:

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

> _Andre_
Делаю то же самое, но без программы: в Ворде Ctrl+C, затем в АКАДе _.text и на приглашение Enter text: жмакнуть Ctl+V и потом для завершения Enter.
Можно и в окно MTEXT'а - тогда даже сохранится часть форматирования.

PS с "длинными" строками, которые получились из абзацев, все равно воевать придется

Вы абсолютно правы.

Все отлично переносится простой вставкой, а ТАБЛИЦЫ!? Таблицы теряют формат :cry:

vk · 17.03.2006, 20:38

Цитата:

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

а ТАБЛИЦЫ!? Таблицы теряют формат :cry:

Ничего они не теряют. Таблицы непосредственно САМИ ТЕРЯЮТСЯ. Остаются только параграфы текста, представленные как строки и расположенные подряд друг за другом. Есть несколько вариантов. Либо вставлять их через OLE. Либо экспорт в Ексель, а оттуда через ATABLE (как вариант - сделать свою Лисп-программку). Либо, кропотливо лазить в дебрях объектной модели вордовского дока, вылавливая как минимум всевозможные объединения ячеек (а наобъединять можно еще как!) и свойства в них размещенного текста (наформатировать можно не хуже!), и по полученным данным создавать новую таблицу в АКАДе. С нуля.
Если структура таблиц проста, а к форматированию текста не предъявлять требований, то можно сделать достаточно просто: сохранить док как "текст с форматированием *.ans" (млин, кто ж чистому тексту такое название то придумал...), а затем вставить в акад через командную строку в TEXT или MTEXT. После "натянуть" линии таблицы. По крайней мере, нет проблемы "длинных" строк.

kminas · 18.03.2006, 11:52

Цитата:

Таблицы непосредственно САМИ ТЕРЯЮТСЯ.

В том то и дело, что вставкой прямой или через OLE в 2002-м таблица вставляется , но безразмерно. Есть ВСЕ строки и ВСЕ столбцы, но они растягиваются подчас больше, чем формат листа, а в Excel экспортировать себе дороже. Там вообще все сжимается или растягивается, а остальное попробую, т.к. в ЛИСПе я дуб. Что такое *.ans пока не знаю, но буду изучать. Во всяком случае, пока спасибо!
Кстати, мне уже советовали на форуме autocad.ru http://www.autocad.ru/cgi-bin/f1/board.cgi?t=24321iE средствами VBA так:

Цитата:

На прямую не получится. Нужно по своиствам таблицы в Word

Код:

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

NumColumns=ActiveDocument.Tables(1).Columns.Count
NumRows=ActiveDocument.Tables(1).Rows.Count

*Voland* · 20.04.2006, 10:40

Подскажите пожалуйста как применять код, который для переноса текста из Autocad в Word, или я не правильно понял чего добивались. :?: Если не сложно - пошагово

kminas · 20.04.2006, 20:27

Можно перенести таблицы из Word в AutoCAD, но я, к сожалению, еще плохо разбираюсь в AutoCAD'e, а в VBA в AutoCAD'e вообще не разбираюсь. Купил книгу Н.Н. Полещука, но пока читать некогда - отдал специалистам разобраться. А сам Полещук вот что мне ответил по вопросу переноса :

Цитата:

Быстро не получится.
При автоматическом заполнении придется все подробно нализировать. Схема работа с объектами Word у меня описана в книге, которую Вы купили, есть примеры такой задачи для Excel, изучайте.
С уважением, Н.Н.Полещук

_Andre_ · 21.04.2006, 07:25

Если говорить про первоначальный вариант функции - то цель была перенести содержимое нескольких однострочных текстов из акада в ворд.
1.Открываете чертеж в акаде и документ в ворде
2.Запускаете функцию
3.Выделяете нужные строки текста
4.ентер
5.содержимое текстов переноситься в ворд

В конечном варианте в этой функции присутсвует сортировка строк по координате "у".

Основная цель - избежать входа в редактирование каждой строки копирования содержимоего, переход в ворд и там вставка и так столько раз сколько строк.

*Voland* · 21.04.2006, 10:22

А какую запускать функцию. Обычно когда я смотрел лиспы там присудствует строка
(defun c:brr...), где brr как раз функция которую нужно набирать в коммнадной строке. А в вашем коде я такого увидеть не смог.

VVA · 21.04.2006, 11:07

В посте №1 представлена только ф-ция. Необходимо дописать выбор
и сортировку текста. Например так

Код:

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

;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=23&TID=25197&MID=143539#message143539
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun

;;;;ТЕКСТ из АКАД в WORD http://forum.dwg.ru/showthread.php?t=5993&page=2
(defun ba-text-from-acad-to-word (text / _ba-release-object ActiveDocument msw work_range) 
;;;Функция освобождает объект 
  (defun _ba-release-object (obj_name /) 
    (if   (and obj_name (vlax-object-released-p obj_name)) 
      (vlax-release-object obj_name)) 
    (setq obj_name nil)) ;_ end defun 
;;;end of _ba-release-object 
  (if (setq msw (vlax-get-or-create-object "Word.Application")) 
    (if   (if (vl-catch-all-error-p 
        ;|Пробую узнать активный документ, с отловом ошибкина случай если WORD запушен, но нет открытых документов.|; 
         (setq ActiveDocument 
           (vl-catch-all-apply 
             'vlax-get-property 
             (list msw 'activedocument) ;_ end list 
           ) ;_ end vl-catch-all-apply 
         ) ;_ end setq 
       ) ;_ end vl-catch-all-error-p 
     (setq activedocument nil) 
;;;Если вернулась ошибка, то активного док-та нет и функция вернет nil 
     ActiveDocument 
;;;Если ошибки не было, то акт. док-т есть, то вернеттся указатель на него. 
   ) ;_ end if 
      (progn (vla-put-visible msw :vlax-true) 
;;;Делаем Word видимым 
        (setq work_range (vlax-invoke-method ActiveDocument 'range 0 0)) 
;;;Текст в начало документа        (vlax-invoke-method  work_range  "insertafter"  text)
        (vlax-invoke-method (vlax-get-property msw "Selection") "InsertAfter" text) 	
      ) ;_ end progn 
      (princ "\nНет активного документа!!!") 
    ) ;_ end if 
    (princ "\nWORD не запускается!!!") 
  ) ;_ end if 
  (_ba-release-object work_range) 
  (_ba-release-object ActiveDocument) 
  (_ba-release-object msw))

;|
 * Текст из Акада в WORD
 * http://forum.dwg.ru/showthread.php?t=5993&page=2
 * Передает выбранный текст в активный документ WORD в текущюю позицию курсора
 * с сортировкой по Y. Обрабатывает TEXT и MTEXT. MTEXT разбивает по параграфам
 * Командная строка TAW
|;

(defun C:TAW ( / sset lst)
(setq sset (ssget '((0 . "*TEXT"))))
(if sset
  (progn
 (setq lst
       (mapcar 
        (function vlax-ename->vla-object)
        (vl-remove-if
         (function listp)
         (mapcar (function cadr) (ssnamex sset))
        ) ;_ vl-remove-if
       ) ;_  mapcar
 ) ;_  setq
 (setq lst (vl-sort lst  ;_Сортировка по Y
		    (function (lambda (e1 e2)
				(> (cadr (vlax-get e1 'Insertionpoint))
				   (cadr (vlax-get e2 'Insertionpoint)))))))
       (mapcar
	 (function(LAMBDA ( vla-txt )
		    (mapcar (function(LAMBDA ( txt )
				       (ba-text-from-acad-to-word (strcat txt "\n"))))
		    (STR-STR-LST
		      (vla-get-TextString vla-txt) "\\P"))))
	 lst)
 (princ "\nОбработано ")(princ (length lst)) (princ " примитивов"))))
(princ "\nНаберите в командной строке TAW")

Как запускать лисп здесь

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