Передача координат из ACAD в MSWORD

Передача координат из ACAD в MSWORD · 11.02.2009, 10:06

Собственно нужно передать координаты многоугольника в ворд.
перерыл тычу форумов и негде такого нет.
Кто-нибудь могет посоветовать как это реализовать...

Олег (jr.) · 11.02.2009, 11:59

Что значит передать?
Создать новый документ или использовать существующий?
Залить данные в таблицу или просто добавить в виде
строк?
Многоугольник очевидно - облегченная полилиния?

~'J'~

VVA · 11.02.2009, 17:26

armagg, В Excell можно, а оттуда в WORD.
http://forum.dwg.ru/showthread.php?t=20509
Про WORD
http://forum.dwg.ru/showthread.php?t=5993

T-Yoke · 11.02.2009, 17:52

Цитата:

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

Собственно нужно передать координаты многоугольника в ворд. Перерыл тычу форумов и негде такого нет.
Кто-нибудь могет посоветовать как это реализовать...

То есть, у вас есть список координат, и вам нужно вставить в Word документ. И Всё?
А копи-паст, не работает? Или лучше продемонстрируйте как ваш список кординат выглядит.

armagg · 11.02.2009, 18:31

У меня в ворде шаблон, в нем есть таблица...
надо чтобы автоматически эта таблица заполнялась координатами и названиями вершин...

T-Yoke · 11.02.2009, 18:39

Цитата:

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

У меня в ворде шаблон, в нем есть таблица...
надо чтобы автоматически эта таблица заполнялась координатами и названиями вершин...

Раз таблица, то логичней её было сделать в Excel, сделав связь соответствующих ячеек с данными таблиц ваших координат (и название, и значение), а так как в Word можно вставить таблицу Excel сохранив все её связи, то все получается не очень сложным.

armagg · 11.02.2009, 18:56

Хорошо, а как в эксель их передать?

Олег (jr.) · 11.02.2009, 19:19

Цитата:

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

У меня в ворде шаблон, в нем есть таблица...
надо чтобы автоматически эта таблица заполнялась координатами и названиями вершин...

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

Код:

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

(vl-load-com)
;; Вспомогательные функции

;; Группировка списка по числу элементов субсписка

(defun group-by-num  (lst num / ls ret)
  (if (= (rem (length lst) num) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
	(repeat	num
	  (setq	ls
		    (cons (car lst) ls)
		lst (cdr lst)))
	(setq ret (append ret (list (reverse ls)))
	      ls  nil)))
    )
  ret
  )

;; список координат полилинии

(defun get-vexs	 (pline_obj / verts)
  (setq	verts (vlax-get pline_obj 'Coordinates)
	verts
	      (cond
		((wcmatch (vlax-get pline_obj 'Objectname)
			  "AcDb2dPolyline,AcDb3dPolyline")
		 (group-by-num verts 3)
		 )
		((eq (vlax-get pline_obj 'Objectname)
		     "AcDbPolyline")
		 (group-by-num verts 2)
		 )
		(T nil)
		)
	)
  )

;; основная программа

(defun C:PW (/ actdoc cll clls cnt copytab currng first header headlist i j pline_obj
	       pt ptlist sel ss tblobj wrdapp wrddocs wdname x)
  (if
  (setq ss (ssget "+.:S:E" '((0 . "LWPOLYLINE")(70 . 1))))
  (progn
    (setq pline_obj (vlax-ename->vla-object (ssname ss 0)))
    (setq ptlist (get-vexs pline_obj))
    (setq wrdapp (vlax-get-object "Word.Application"))
  (if
  (not wrdapp)
   (setq wrdapp (vlax-create-object "Word.Application"))
      )
      (vla-put-visible wrdapp :vlax-true)
      (setq wrddocs (vlax-get-property wrdapp 'Documents))
      (vlax-invoke-method wrddocs 'Add nil nil)
      (setq actdoc (vlax-get-property wrdapp 'Activedocument))
      (vlax-invoke-method actDoc 'Activate)
      (setq currng (vlax-get-property wrdapp 'Selection)
       )
      (vlax-invoke-method currng 'TypeText "КООРДИНАТЫ УЧАСТКА:\n")

      (vlax-put-property (vlax-get-property (setq first (vlax-get-property
        (vlax-get-property actdoc 'Paragraphs) 'First)) 'Format) 'Alignment 0)
   (vl-catch-all-apply
    (function (lambda ()
      (vlax-put-property
      (vlax-get-property (vlax-get-property first 'Range) 'Font)
      'Bold
      :vlax-true
          )
        )
    )
  )
      (vlax-invoke-method
  currng
  'InsertParagraphAfter
      )
    (setq currng (vlax-get-property
         (vlax-get-property wrdapp 'Selection)
         'Range
       )
      )

      (setq tblobj (vlax-invoke-method
         (vlax-get-property currng 'Tables)
         'Add
         currng
         (1+ (length ptlist))
         3
       )
      )
    (vlax-put-property
      (vla-item (vlax-get-property tblobj 'Columns) 1)
      'Preferredwidth
      (vlax-make-variant 64.0 5)
      )
    (foreach cl '(2 3)
      (vlax-put-property
      (vla-item (vlax-get-property tblobj 'Columns) cl)
      'Preferredwidth
      (vlax-make-variant 120.0 5)
      )
      )
      (setq i 1)
      (setq clls (vlax-get-property
       (vlax-get-property tblobj 'Range)
       'Cells
     )
      )
      (setq headlist
       (list "Number:" "X coordinate:" "Y coordinate:")
      )
      (repeat (length headlist)
  (setq header (car headlist))
  (setq cll (vlax-get-property
        (vlax-invoke-method clls 'Item i)
        'Range
      )
  )
  (vlax-put-property cll 'Text (vlax-make-variant header 8))
  (vl-catch-all-apply
    (function (lambda ()
          (vlax-put-property
      (vlax-get-property cll 'Font)
      'Bold
      :vlax-true
          )
        )
    )
  )

  (setq i (1+ i))
  (setq headlist (cdr headlist))
      )
    (setq cnt 0)
      (repeat (length ptlist)
	(setq cnt (1+ cnt))
	  (setq  cll (vlax-get-property
          (vlax-invoke-method clls 'Item i)
          'Range
        )
    )
    (vlax-put-property
      cll
      'Text
      (vlax-make-variant (itoa cnt) 8)
    )
    (setq i (1+ i))
  (setq pt (car ptlist))
  (setq j 0)
  (repeat  (length pt)
    (setq  cll (vlax-get-property
          (vlax-invoke-method clls 'Item i)
          'Range
        )
    )
    (vlax-put-property
      cll
      'Text
      (vlax-make-variant (rtos (nth j pt) 2 3) 8)
    )
    (setq j (1+ j))
    (setq i (1+ i))
  )
  (setq ptlist (cdr ptlist))
      )
   (setq shortname (getvar "dwgname")
      fullname (strcat (getvar "dwgprefix") shortname)) 
      (vlax-invoke-method
  actdoc
  'Saveas
  (setq wdname (vl-string-subst "DOC"  (substr shortname 1 (- (strlen shortname) 4))
                                     fullname (- (strlen fullname) 4)))
      )
      (vlax-invoke-method actdoc 'Close :vlax-true)
      (vlax-invoke wrdapp 'Quit)
      (mapcar (function  (lambda  (x)
        (vl-catch-all-apply
          (function (lambda ()
          (progn
            (vlax-release-object x)
            (setq x nil)
          )
              )
          )
        )
      )
        )
        (list cll clls tblobj copytab currng first sel actdoc wrddocs wrdapp)
      )
    )
  )
  (gc)
(alert (strcat "Документ сохранен с именем:\n" wdname))
  (princ)
)

Чуть не забыл, указатель на приложение Word в твоем
случае лучше получать через GetObject

~'J'~

armagg · 11.02.2009, 20:37

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

Олег (jr.) · 11.02.2009, 21:16

Код:

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

;; cw.lsp
;; запись координат контура в таблицу существующего документа
(vl-load-com)
;; Вспомогательные функции

;; Группировка списка по числу элементов субсписка

(defun group-by-num  (lst num / ls ret)
  (if (= (rem (length lst) num) 0)
    (progn
      (setq ls nil)
      (repeat (/ (length lst) num)
	(repeat	num
	  (setq	ls
		    (cons (car lst) ls)
		lst (cdr lst)))
	(setq ret (append ret (list (reverse ls)))
	      ls  nil)))
    )
  ret
  )

;; список координат полилинии

(defun get-vexs	 (pline_obj / verts)
  (setq	verts (vlax-get pline_obj 'Coordinates)
	verts
	      (cond
		((wcmatch (vlax-get pline_obj 'Objectname)
			  "AcDb2dPolyline,AcDb3dPolyline")
		 (group-by-num verts 3)
		 )
		((eq (vlax-get pline_obj 'Objectname)
		     "AcDbPolyline")
		 (group-by-num verts 2)
		 )
		(T nil)
		)
	)
  )

;;  основная программа

(defun C:CW  (/
	      actdoc
	      cll
	      clls
	      cnt
	      fullname
	      i
	      j
	      pline_obj
	      pt
	      ptlist
	      shortname
	      ss
	      tblobj
	      wdname
	      wrdapp
	      wrddocs
	      x)
  (if
    (setq ss (ssget "+.:S:E" '((0 . "LWPOLYLINE") (70 . 1))))
     (progn
       (setq pline_obj (vlax-ename->vla-object (ssname ss 0)))
       (setq ptlist (get-vexs pline_obj))
       (setq wdname (getfiled "Выбрать документ или шаблон Word"
			      (getvar "dwgprefix");; --> заменить на папку шаблонов
			      "doc;dot;*"
			      2))
       (alert "Ждите завершения работы приложения Word")
       (setq wrdapp (vlax-get-or-create-object "Word.Application"))
       (vla-put-visible wrdapp :vlax-true)
       (vlax-put-property wrdapp 'ScreenUpdating :vlax-false)
       (setq wrddocs (vlax-get-property wrdapp 'Documents))
       (vlax-invoke-method wrddocs 'Open wdname)
       (setq actdoc (vlax-get-property wrdapp 'Activedocument))
       (vlax-invoke-method actDoc 'Activate)
       
       (setq tblobj (vla-item
		      (vlax-get-property actDoc 'Tables)
		      1 ; --> индекс таблицы в документе (здесь - первая таблица документа)
		      )
	     )
       (setq clls (vlax-get-property
		    (vlax-get-property tblobj 'Range)
		    'Cells
		    )
	     )
       (setq i	 4 ; --> номер первой заполняемой ячейки (вторая строка 3-х колоночной таблицы)
	     cnt 0)
       (repeat (length ptlist)
	 (setq cnt (1+ cnt))
	 (setq cll (vlax-get-property
		     (vlax-invoke-method clls 'Item i)
		     'Range
		     )
	       )
	 (vlax-put-property
	   cll
	   'Text
	   (vlax-make-variant (itoa cnt) 8)
	   )
	 (setq i (1+ i))
	 (setq pt (car ptlist))
	 (setq j 0)
	 (repeat (length pt)
	   (setq cll (vlax-get-property
		       (vlax-invoke-method clls 'Item i)
		       'Range
		       )
		 )
	   (vlax-put-property
	     cll
	     'Text
	     (vlax-make-variant (rtos (nth j pt) 2 3) 8)
	     )
	   (setq j (1+ j))
	   (setq i (1+ i))
	   )
	 (setq ptlist (cdr ptlist))
	 )
       (setq shortname (getvar "dwgname")
	     fullname  (strcat (getvar "dwgprefix") shortname))
       (vlax-put-property wrdapp 'ScreenUpdating :vlax-true)
       (vlax-invoke-method
	 actdoc
	 'Saveas
	 (setq wdname (vl-string-subst
			"DOC"
			(substr shortname 1 (- (strlen shortname) 4))
			fullname
			(- (strlen fullname) 4)))
	 )
       (vlax-invoke-method actdoc 'Close :vlax-true)
       (vlax-invoke wrdapp 'Quit)
       (mapcar (function (lambda (x)
			   (vl-catch-all-apply
			     (function (lambda ()
					 (progn
					   (vlax-release-object x)
					   (setq x nil)
					   )
					 )
				       )
			     )
			   )
			 )
	       (list cll clls tblobj actdoc wrddocs wrdapp)
	       )
       )
     )
  (gc)
  (alert (strcat "Документ сохранен под именем:\n" wdname))
  (princ)
  )

На скорую руку переделал, как добавить строки в таблицу
см. метод Add для свойства таблицы Rows
Добавить 100 строк:

Код:

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

(repeat 100
(vlax-invoke-method (vlax-get-property tblobj 'Rows)
  'Add)
  )

~'J'~

armagg · 11.02.2009, 22:25

спасибо...

Олег (jr.) · 11.02.2009, 22:41

Успехов

~'J'~

armagg · 11.02.2009, 22:50

Извиняюсь за доставучесть....

где надо указать, что бы выводилось 3 знака после запятой?
как сделать чтобы вводить в таблицу где больше столбцов....
первую ячейку он ловить..а дальше шлепает все подрят...т.е не переносит на новую строку...

Олег (jr.) · 11.02.2009, 23:35

Счет ячеек идет змейкой, если больше
столбцов то добавляй для переменной i
не единицу, а шаг в виде разницы между
количеством столбцов в таблице и теми
данными которые ты заливаешь, в данном
случае i = i + Количество_Столбцов - 3

PS Обычно здесь принято делать скриншот таблицы
или вкладывать свой файл (см. значок "Скрепка" наверху
окна сообщения) чтобы было более понятно чё те надо

~'J'~

11.02.2009, 10:06		#1
Передача координат из ACAD в MSWORD armagg Инженерные изыскания СПб Регистрация: 11.02.2009 Сообщений: 6 Собственно нужно передать координаты многоугольника в ворд. перерыл тычу форумов и негде такого нет. Кто-нибудь могет посоветовать как это реализовать...
Просмотров: 3558

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Проблема со шрифтами Acad 2006 - Acad 2008	Cartman	AutoCAD	40	15.03.2013 09:05
перенос настроек acad 2004 в acad 2008	mvart	AutoCAD	9	23.01.2008 19:48
2 системы координат в одном файле	SStas	AutoCAD	8	20.06.2007 10:22
Помощь по Лире	Серега М	Лира / Лира-САПР	52	28.05.2007 02:47
управление системой координат Автокад из Делфей	Владимир В	Программирование	12	27.04.2005 09:54