Тема: Как перенести текст из AutoCAD в Word?

Как перенести текст  из AutoCAD  в Word?

Re: Как перенести текст из AutoCAD в Word?

Cut and Paste

Re: Как перенести текст из AutoCAD в Word?

Уточнение: из Cut (или Copy) не из поля чертежа, а из текстового редактора автокада. То есть сначала команда Ddedit

Re: Как перенести текст из AutoCAD в Word?

Спасибо за ответы. Но я не четко сформулировал вопрос.
Уточнение:  Как перенести текст из AutoCAD в Word (множество однострочных или многострочных примитивов) сразу одной операцией. Возможно ли это? Пробовал скопировать множество текстовых примитивов через буфер обмена в Paint, а затем растровое изображение распознать как текст с помощью программы FineReader и  отправить в Word, но что-то не получается. Получается нечеткое изображение и далее FineReader не распознает.

Re: Как перенести текст из AutoCAD в Word?

> Kami
Да, такие вещи можно сделать программно. Нечто аналогичное лежит в Sample, кажется с 2004 АКАДом. Но для заточки под конкркетные нужды нужно "слегка" доработать.

Re: Как перенести текст из AutoCAD в Word?

Примерно так

(vl-load-com)
(defun c:txt2word (/ msw ss ent pgs)
  (if (setq msw (vlax-get-or-create-object "Word.Application"))
    (progn
      (setq pgs (vlax-get-property (vlax-invoke-method (vla-get-documents msw) "add") "paragraphs"))
      (princ "\nУкажите примитивы TEXT")
      (setq ss (ssget '((0 . "TEXT"))))
      (while (> (sslength ss) 0)
        (setq ent (ssname ss 0))
        (vlax-invoke-method
          (vlax-get-property (vlax-get-property pgs "last") "range")
          "insertafter"
          (strcat (vla-get-textstring (vlax-ename->vla-object ent)) "\n")
        ) ;_  vlax-invoke-method
        (ssdel ent ss)
      ) ;_  while
      (vlax-release-object pgs)
      (vla-put-visible msw :vlax-true)
      (vlax-release-object msw)
      (princ "\nГотово.\n")
    ) ;_  progn
    (princ "\nMicrosoft Word не стартует.\n")
  ) ;_  if
  (princ)
) ;_  defun
(princ)

выбрать примитивы и потом сохранить документ Word.
Это только для однострочных текстов, для многострочных нужна более серьезная обработка.

(изменено: Айрат, 6 декабря 2014г. 12:09:48)

Re: Как перенести текст из AutoCAD в Word?

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

Re: Как перенести текст из AutoCAD в Word?

;;; CADALYST 08/05    Tip 2053: SaveDoc.lsp    Text into a MS Word File (c) Andrzej Gumula


;;; This routine exports selected text to Word document
;;; Microsoft Office must be installed in Windows
;;; *********************************************************
;;; Andrzej Gumula
;;; ul. Modrzewiowa 19/54
;;; 40-171 Katowice POLAND
;;; email: a.gumula@wp.pl

(defun c:Save2Doc (/ TxtSet Word Docs NewDoc Paragraphs Range
                    OldTxtList NewTxt IdTxtList FontName Txt Count
            Flag#1 Flag#2)

(defun Dxf (Index)
 (cdr (assoc Index (entget (ssname TxtSet Count))))
);end Dxf

(defun ClearMTFormat (Str / Item TLength Char New);;; clear mtext format in string
  (setq Item 1 TLength (strlen Str) New "")
  (while (<= Item TLength)
   (setq Char (substr Str Item 1))
   (if    (= Char "\\")                
     (progn
      (setq Item (1+ Item))        
      (setq Char (substr Str Item 1))
      (cond
       ((member Char '("\\" "f" "F" "C" "H" "S" "T" "Q" "W"))
        (while (and (/= Char ";") (<= Item TLength))
         (setq Item (1+ Item))
         (setq Char (substr Str Item 1))
        );end while
       )
       ((= Char "P")
        (setq New (strcat New "\n"))
       )
       ((member Char '("{" "}"))
    (setq New (strcat New Char))
       )
      );end cond
     );end progn
     (if (not (member Char '("{" "}")))
      (setq New (strcat New Char))            
     );end if
    );end if
    (setq Item (1+ Item))
   );end while
   (cond (New) (T ""))
);end ClearMTFormat

(defun GetOpenDocs (Docs / Item Names);;; list of open Word documents
  (repeat (setq Item (vla-get-count Docs))
   (setq Names (cons (strcase (findfile (vla-get-fullname (vla-item Docs Item)))) Names)) 
   (setq Item (1- Item))
  );end repeat
  Names
);end GetOpenDocs
  
(princ "\nSelect TEXT (MTEXT) to export to Word document: ")
(cond 
 ((setq TxtSet (ssget '((0 . "*TEXT"))))
  (cond
  ((setq File (getfiled "Select Word document" (strcat (vl-filename-base (getvar "dwgname")) ".doc") "doc" 1))
   (vl-load-com)
   (prompt "\nExport text to Word. Please wait...")
   (princ)
   (if (not (setq Word (vlax-get-object "Word.Application")));;;is already open ?
    (setq Word (vlax-get-or-create-object "Word.Application"));;; no open
    (setq Flag#1 T)
   );end if
   (cond
    (Word
    (if (not Flag#1) (vla-put-visible Word :vlax-false));;; hide window application
    (if (findfile File)
     (setq Flag#2 (member (strcase (findfile File)) (GetOpenDocs (vlax-get-property Word 'Documents)))
       NewDoc (vlax-invoke-method (vlax-get-property Word 'Documents) 'Open File))
     (setq  NewDoc (vlax-invoke-method (vla-get-documents Word) 'add))
    );end if
    (setq Paragraphs (vlax-get-property NewDoc 'Paragraphs) Count 0)  
    (repeat (sslength TxtSet)
     (setq String (vla-get-TextString (vlax-ename->vla-object (ssname TxtSet Count))))
     (setq Range (vlax-get-property (vlax-get-property Paragraphs 'last) 'Range))
     (if (not (setq FontName (cdar (cdadr (assoc -3 (entget (tblobjname "STYLE" (Dxf 7)) '("ACAD")))))))
      (setq FontName (vl-filename-base (cdr (assoc 3 (tblsearch "STYLE" (Dxf 7))))))
     );end if
     (vlax-put-property (vlax-get-property Range 'Font) 'Name FontName)
     (if (= (Dxf 0) "MTEXT") (setq String (ClearMTFormat String)))
     (vlax-invoke-method Range 'InsertAfter (strcat String "\n"))
     (setq Count (1+ Count))
    );end repeat
    (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-saveas (list NewDoc File)))
      (prompt "\nProbably selected file is read-only. Cannot export text to this file. ")
      (vla-saveas NewDoc File);;; save document
    );end if
    (cond
     ((not Flag#1)
      (vla-quit Word 0)
     )
     (T (if (not Flag#2) (vla-close NewDoc));;; close application
        (vla-put-visible Word :vlax-true);;; show application
     )
    );end cond
    (mapcar 'vlax-release-object (list Word NewDoc Paragraphs Range));;; objects release
    (mapcar '(lambda (x) (set x nil)) '(Word NewDoc Paragraphs Range));;; null all variables
    )
   (T (prompt "\nCan't create Word document. Microsoft Ofice must be installed. "))
  );end cond Word
  )
  (T (prompt "\nFile no selected. "))
 );end cond
 )
 (T (prompt "\nNothing selected. "));;; text no selected
);end cond
 (princ)
);end c:Save2Doc

(defun c:SD ()
  (c:Save2Doc)
);end c:SD

(prompt "\nLoaded new command Save2Doc [SD]. ")
(prompt "\n[c]2004 Andrzej Gumula. ")
(princ)

;************** in the future - maybe in next version ?
;(vlax-invoke-method Range 'InsertSymbol 176 nil)   ;degree%%d
;(vlax-invoke-method Range 'InsertSymbol 177 nil t) ;plus-minus%%p
;(vlax-invoke-method Range 'InsertSymbol 216 nil t) ;diameter%%c

 

Re: Как перенести текст из AutoCAD в Word?

https://youtu.be/3FMElR2Xg9M пример макроса на vba, переносит из dwg /dgn в таблицу в Ворд и обратно на чертеж . Многостраничный и однострочный текст, и многостраничный и однострочный текст из cell не разбивая их. Могу подсказать как чего реализовывал .