перенос данных и автокада в эксель

evg76 · 30.06.2009, 11:59

Добрый день уважаемые !!!
Есть вопрос.
существует программка в лиспе по формированию координат в txt файл и геоданных в поле автокада, можно ли перетащить данные в эксель и так как это сделано в прилагаемом файле.
даннные в xls. файле были сделаны в vba(работает из пд экселя) но прога сырая и не всегда работает

либо же прикрутить lisp+vba

Кулик Алексей aka kpblc · 30.06.2009, 15:03

evg76, а ты поиском займись, вопрос по эскпорту точек в сторонние файлы поднимался уже не один десяток раз.

evg76 · 30.06.2009, 15:18

Я уже порылся много чего видел.
проблема не переносе данных, а в их формировании в экселе,
прога должна помогать, а не просто так вытащил данные и сидишь опять паришься сладываешь сшиваешь и т.д.

john644 · 01.07.2009, 11:55

Непонятна проблема в экселе при задании табуляции или точки с запятой все прекрасно вставляется и работает

evg76 · 01.07.2009, 13:24

в настощее время липовская программа формирует всего лиш отчет по координатам в txt файле. кроме координат там нет ничего,а хотелось бы увидеть отчет такой как представлен в экселевском файле посредством лиспа

john644 · 01.07.2009, 13:28

Ну так и открывайте txt файл экселем. В чем проблема?

evg76 · 01.07.2009, 13:37

см. zip файл. тогда поймешь в чем проблема

john644 · 01.07.2009, 13:45

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

evg76 · 01.07.2009, 14:57

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

john644 · 01.07.2009, 15:03

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

evg76 · 01.07.2009, 15:46

а как насчет прикутить к лиспу фишку сляпанную в VBA

Олег (jr.) · 01.07.2009, 20:40

Цитата:

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

а как насчет прикутить к лиспу фишку сляпанную в VBA

Это не так уж сложно объектная модель читаема и в Лиспе:

Код:

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

;; local defuns

;; get coordinates
;; based on function borrowed from Gille Chanteau (gile)
(defun get_flat_coordinates	(en / pa pl pt lst)

  (setq pl (vlax-ename->vla-object en))
  (setq	pa (if (vlax-curve-isclosed pl)
	     (vlax-curve-getendparam pl)
	     (+ (vlax-curve-getendparam pl) 1)
	     )
	)
  (while (setq pt (vlax-curve-getpointatparam pl (setq pa (- pa 1))))
    (setq lst (cons (list (car pt)(cadr pt)) lst))
    )
  )


(defun set_cell_value (rang value)
  (vlax-put-property
	    rang
	    "Value2"
	    (vl-princ-to-string value)
	  )
  )


(defun set_value (rang row column value)
  (vlax-put-property
	    rang
	    "Item"
	    row
	    columm
	    (vl-princ-to-string value)
	  )
  )


(defun set_cell_format	(rang
			 IsMerged
			 FontName
			 TextSize
			 IsBold
			 IsItalic
			 ColorIndex
			 HAlign
			 VAlign
			 NumberFormat)
  (if IsMerged
    (progn
      (vlax-invoke-method rang "Select")
      (vlax-put-property rang "MergeCells"
	(vlax-make-variant 1 11)))
    )
  (setq Fonto (vlax-get-property rang "Font"))
  (vlax-put-property
    Fonto
    "Name"
    (vlax-make-variant FontName 12))
  (vlax-put-property
    Fonto
    "Size"
    (vlax-make-variant TextSize 5))
  (if IsBold
    (vlax-put-property Fonto "Bold" (vlax-make-variant 1 11)))
  (if IsItalic
    (vlax-put-property Fonto "Italic" (vlax-make-variant 1 11)))
  (vlax-put-property
    Fonto
    "Colorindex"
    (vlax-make-variant ColorIndex))		  ; 5 - blue, 0 - black
  (vlax-put-property
    rang
    "Horizontalalignment"
    (vlax-make-variant HAlign 3))		  ;-4131 - left, -4108 - center  
  (vlax-put-property
    rang
    "VerticalAlignment"
    (vlax-make-variant VAlign 3))
  (vlax-put-property
    rang
    "NumberFormat"
    (vlax-make-variant NumberFormat 12))
  )


(defun set_borders (Rang)
  (setq Bords (vlax-get-property Rang "Borders"))

  (setq cnt 0)
    (vlax-for a Bords
      (setq cnt (1+ cnt))
      (vl-catch-all-apply (function (lambda()
      (progn				      
      (if (< cnt 5)
      (progn	
      (vlax-put-property a "LineStyle"
	(vlax-make-variant 1 3))
      (vlax-put-property a "Weight"
	(vlax-make-variant 3 3))
      (vlax-put-property a "ColorIndex"
	(vlax-make-variant 0 5)))
	;; turn off the diagonal lines:
      (vlax-put-property a "LineStyle" (vlax-make-variant -4142 3))
	))))))
)


(defun set_validation_list  (Rang Address)
  (vlax-invoke-method Rang "Select")
  (setq valid (vlax-get-property Rang "Validation"))
  (vlax-invoke-method valid "Delete")
  (vlax-invoke-method valid "Add" 3 1 1 (strcat "=" Address))
  )




; Convert value in radians to degrees
(defun rtd (a)
  (* 180.0 (/ a pi))
)

;; автор функции преобразования угла - Владимир Клещёв (aka VK):

   
   (defun gr->gms (a / g m s)
     (setq g (rtos (fix a) 2 0))
     (setq m (rtos (fix (* (setq a (- a (fix a))) 60)) 2 
0))
     (setq s (rtos (fix (* (- (* a 60) (fix (* 60 a))) 
60)) 2 0))
     (strcat g
             "° " ;; авторский текст "%%d " - для других шрифтов
             (if (= (strlen m) 2)
               m
               (strcat "0" m)
             ) ;_  if
             "' "
             (if (= (strlen s) 2)
               s
               (strcat "0" s)
             ) ;_  if
             "\""
     ) ;_  strcat
   ) ;_  defun


;; end of local defuns
 
(vl-load-com)
;;; =====================   main part   =======================;;

(defun C:meva  (/ aexc ans ch cls cnt col columns coords count csht dls ds en frow
		nwb rang row scoords sht ss valid_list wbks widths x xs ys)
  
  (setq	ss (ssget "+.:S:E:L"  (list (cons 0 "*POLYLINE")))
	)
    (setq en (ssname ss 0))
    (setq coords (get_flat_coordinates en)
	  scoords (append (cdr coords)(list (car coords)))	  
	  count (length coords)
	  )

  (setq dls (mapcar (function (lambda(x y)
				(distance x y)))
		    coords
		    scoords)
	)
  (setq ans (mapcar (function (lambda(x y)
				(gr->gms (rtd (angle x y)))))
		    coords
		    scoords)
	)
  ;;==========================================================;;
  
  ;;	***	Excel part	***	;;
    (alert "Save Excel manually")
    (setq aexc (vlax-get-or-create-object "Excel.Application")
	  wbks  (vlax-get-property aexc "Workbooks")
	  nwb  (vlax-invoke-method wbks "Add")
	  sht  (vlax-get-property nwb "Sheets")
	  csht (vlax-get-property sht "Item" 1)
	  cls  (vlax-get-property csht "Cells")
    )
    (vlax-put-property csht "Name" "общий")
    (vla-put-visible aexc :vlax-true)
    (vlax-invoke-method aexc "Volatile")
    (vlax-invoke-method aexc "ScreenUpdating" :vlax-false)
   ;; store validation list sources
   ;; 1st list
  (setq frow 1000
	row frow
	cnt 0)
(setq valid_list
	       (list
		 "временный меж. знак"
		 "металлический штырь"
		 "столб дер. забора"
		 "угол кам. ограждения"
		 "угол КН"
		 "столб")
      count    (length valid_list)
      )
  (repeat count
      (setq rang (vlax-get-property cls "Range"(strcat "A" (itoa row))))
      (set_cell_format rang nil "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang (nth cnt valid_list)) 
      (setq row (1+ row)
	    cnt (1+ cnt))
	    )
  ;; 2nd list
  (setq row frow
	cnt 0)
     
 (setq valid_list
       (list
	 "по прямой"
	 "по забору"
	 "по контуру пашни"
	 "по контуру леса"
	 "по контуру асфальта"
	 "по стене здания"
	 "по канаве")
      count (length valid_list)
      )
  (repeat count
      (setq rang (vlax-get-property cls "Range"(strcat "B" (itoa row))))
      (set_cell_format rang nil "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang (nth cnt valid_list)) 
      (setq row (1+ row)
	    cnt (1+ cnt))
	    )
  
    ;; 1st table
    ;; headers
    (setq rang (vlax-get-property cls "Range" "A1:C1"))
    (set_value  rang 1 1 "Кадастровый квартал №")
    (set_borders rang)
    (set_cell_format rang T "Times New Roman" 10 T nil 0 -4108 -4108 "@");"@" - Text
  
    (setq rang (vlax-get-property cls "Range" "D1:F1"))
    (set_value  rang 1 1 "Изменение №")
  (set_borders rang)
    (set_cell_format rang T "Times New Roman" 10 T nil 0 -4108 -4108 "@");"@" - Text
  
    (setq rang (vlax-get-property cls "Range" "A2:F2"))
  (set_borders rang)
    (set_value  rang 1 1 
    "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СУЩЕСТВОВАНИЕ УЗЛОВЫХ И ПОВОРОТНЫХ ТОЧКАХ ГРАНИЦ")
    (set_cell_format rang T "Times New Roman" 7.5 T nil 0 -4108 -4108 "@");"@" - Text
  
    (setq rang (vlax-get-property cls "Range" "A3:A4"))
    (set_value  rang 1 1 "Условное обознач.  точки")
  (set_borders rang)
    (vlax-put-property rang "WrapText"
	(vlax-make-variant 1 11))
    (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

    (setq rang (vlax-get-property cls "Range" "B3:C3"))
    (set_value  rang 1 1 "Координаты")
  (set_borders rang)
    (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

      (setq rang (vlax-get-property cls "Range" "B4"))
    (set_value  rang 1 1 "X")
  (set_borders rang)
    (set_cell_format rang nil "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

      (setq rang (vlax-get-property cls "Range" "C4"))
    (set_value  rang 1 1 "Y")
  (set_borders rang)
    (set_cell_format rang nil "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

    (setq rang (vlax-get-property cls "Range" "D3:D4"))
    (set_value  rang 1 1 "f доп, М")
  (set_borders rang)
    (set_cell_format rang nil "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
  
    (setq rang (vlax-get-property cls "Range" "E3:E4"))
    (set_value  rang 1 1 "Описание закрепления   точки")
  (set_borders rang)
    (vlax-put-property rang "WrapText"
	(vlax-make-variant 1 11))
    (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

    (setq rang (vlax-get-property cls "Range" "F3:F4"))
    (set_value  rang 1 1 "Кадастровая запись")
  (set_borders rang)
    (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
    (setq rang (vlax-get-property cls "Range" "A5:F5"))
    (set_cell_format rang nil "Times New Roman" 10 T nil 0 -4108 -4108 "@");"@" - Text
    (setq columns (vlax-get-property csht "Columns"))
    (setq widths (list 19 11 11 11 19 19))
    (setq row 1 col 1 ch 65)
    (repeat count
      (setq rang (vlax-get-property cls "Range"(strcat (chr ch) "5:" (chr ch) "5")))
      (set_cell_value rang (itoa col))
      (set_borders rang)
      (vlax-put-property
	(vlax-get-property cls "Range"(strcat (chr ch) ":" (chr ch)))
	 "ColumnWidth"
	(vlax-make-variant  (nth (1- col) widths) 3))   
      (setq col (1+ col)
	    ch (1+ ch)
	    )
      )
      ;; 1st table body
      ;; coordinates
      (setq xs (mapcar (function (lambda(x)(rtos x 2 3)))(mapcar 'car coords)))
      (setq ys (mapcar (function (lambda(x)(rtos x 2 3)))(mapcar 'cadr coords)))
      ;; 1st column
      (setq row 6 cnt 1)
      (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "A" (itoa row))))
      (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text	
      (set_cell_value rang (strcat "н" (itoa cnt)))
      (setq row (1+ row)
	    cnt (1+ cnt))
      )
  ;;2nd column
     (setq row 6 cnt 0)
     
     (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "B" (itoa row))))
       (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang (nth cnt xs)) 
      (setq row (1+ row)
	    cnt (1+ cnt))
      )
  ;;3rd column
      (setq row 6 cnt 0)
     
     (repeat (length ys)
      (setq rang (vlax-get-property cls "Range"(strcat "C" (itoa row))))
       (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang (nth cnt ys)) 
      (setq row (1+ row)
	    cnt (1+ cnt))
      )

    ;;4th column
      (setq row 6)
     
     (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "D" (itoa row))))
       (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang "7.5") 
      (setq row (1+ row)
	    )
      )
      ;;5th column
      (setq row 6 )
     
     (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "E" (itoa row))))
       (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang "временный меж. знак")

      (set_validation_list rang "$A$1000:$A$1005")
      (setq row (1+ row)
	    )
      ) 

   ;; 2nd table
   ;; headers
    (setq rang (vlax-get-property cls "Range" (strcat "A" (strcat (itoa row) ":F" (itoa row)))))
  (set_borders rang)
    (set_value  rang 1 1 
  "СВЕДЕНИЯ О ВНОВЬ ОБРАЗОВАННЫХ И ПРЕКРАЩАЮЩИХ СУЩЕСТВОВАНИЕ УЧАСТКАХ ГРАНИЦ")
     (set_cell_format rang T "Times New Roman" 7.5 T nil 0 -4108 -4108 "@");"@" - Text
      (setq row (1+ row)
	    )
  
     (setq rang (vlax-get-property cls "Range" (strcat "A" (itoa row) ":A" (itoa (1+ row)))))
  (set_borders rang)
     (set_value  rang 1 1 "От т./до т.")
     (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

     (setq rang (vlax-get-property cls "Range" (strcat "B" (itoa row) ":B" (itoa (1+ row)))))
  (set_borders rang)
     (set_value  rang 1 1 "Длина, м")
     (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

     (setq rang (vlax-get-property cls "Range" (strcat "C" (itoa row) ":C" (itoa (1+ row)))))
  (set_borders rang)
     (set_value  rang 1 1 "DSдоп, м")
     (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

     (setq rang (vlax-get-property cls "Range" (strcat "D" (itoa row) ":D" (itoa (1+ row)))))
  (set_borders rang)
     (set_value  rang 1 1 "  Дирекцион-ный угол, °  '")
     (vlax-put-property rang "WrapText"
	(vlax-make-variant 1 11))
     (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

     (setq rang (vlax-get-property cls "Range" (strcat "E" (itoa row) ":E" (itoa (1+ row)))))
  (set_borders rang)
     (set_value  rang 1 1 "Описание прохождения границы")
     (vlax-put-property rang "WrapText"
	(vlax-make-variant 1 11))
     (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text

     (setq rang (vlax-get-property cls "Range" (strcat "F" (itoa row) ":F" (itoa (1+ row)))))
  (set_borders rang)
     (set_value  rang 1 1 "Кадастровая запись")
     (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
     (setq row (+ row 2))
     (setq col 1 ch 65)
     (repeat count
      (setq rang (vlax-get-property cls "Range"(strcat (chr ch) (itoa row) ":" (chr ch) (itoa row))))
      (set_cell_value rang (itoa col))
       (set_borders rang)
      (set_cell_format rang T "Times New Roman" 10 T nil 0 -4108 -4108 "@");"@" - Text   
      (setq col (1+ col)
	    ch (1+ ch)
	    )
      )
     (setq row (1+ row)
	  frow row
	  )
      ;; 2nd table body
      ;; 1st column
      (setq cnt 1)
      (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "A" (itoa row))))
      (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text	
      (set_cell_value rang (strcat "н" (itoa cnt) "-н" (itoa (1+ cnt))))
      (setq row (1+ row)
	    cnt (1+ cnt)
      )
)
  ;;2nd column
     (setq row frow cnt 0)
     (setq ds (mapcar (function (lambda(x)(rtos x 2 2))) dls))
     (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "B" (itoa row))))
       (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang (nth cnt ds)) 
      (setq row (1+ row)
	    cnt (1+ cnt)
	    )
      )
    ;;3th column
     (setq row frow cnt 0)
     
     (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "C" (itoa row))))
       (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang "5.0") 
      (setq row (1+ row)
	    )
      )
  ;;4th column
     (setq row frow cnt 0)

     (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "D" (itoa row))))
       (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang (nth cnt ans)) 
      (setq row (1+ row)
	    cnt (1+ cnt)
	    )
      )
  
    ;;5th column
     (setq row frow cnt 0)
     
     (repeat (length xs)
      (setq rang (vlax-get-property cls "Range"(strcat "E" (itoa row))))
      (set_cell_format rang T "Times New Roman" 10 nil nil 0 -4108 -4108 "@");"@" - Text
      (set_cell_value rang "по прямой")
      (set_validation_list rang "$B$1000:$B$1006")
      (setq row (1+ row)
	    )
      )

  (vlax-invoke-method aexc "ScreenUpdating" :vlax-true)

  (vlax-invoke-method
nwb
"SaveAs"
"C:\\TestMeva.xls" ;;<--- имя файла изменить !
-4143 ;Excel file format (Excel constant)
nil
nil
:vlax-false
:vlax-false
1
2
)
    (vl-catch-all-apply
      (function	(lambda	()
		  (vlax-invoke-method
		    nwb
		    "Close")))
      )


	(vl-catch-all-apply
	  (function (lambda ()
		      (vlax-invoke-method
			aexc
			"Quit")))
	  )
    (mapcar (function (lambda (x)
			(vl-catch-all-apply
			  (function (lambda ()
				      (vlax-release-object x))))))
	    (list rang cls csht nwb wbks aexc))
    (gc)
    (gc)
    (gc)
  (princ)
  );end of

(princ "\n\t\t\t >>> Start command with: MEVA  <<<")
(prin1)

(vl-load-com)

;;;Test:
;;;(C:meva)

;;========================= end of =======================;;

Я в этом деле полный профан но почему-то
последний угол на 90 гр меньше

~'J'~

evg76 · 02.07.2009, 09:32

; error: ActiveX Server returned an error: несовпадение типо

Олег (jr.) · 02.07.2009, 11:21

Цитата:

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

; error: ActiveX Server returned an error: несовпадение типо

Убрал обновление экрана - оно не во всех
версиях корректно срабатывает
Юзай

~'J'~

evg76 · 02.07.2009, 11:37

усе круто

токо есть 2 где?????
1. там в zip файле есть лисп. он я так понял совсем проигнорирован ( я в смысле мне самому слепить из 2 файлов 1 или это не будет работать.)
2. в экселовском файле есть 2-ой листок с каталогом координат -это можно как то порешать.???

Олег (jr.) · 02.07.2009, 12:40

Цитата:

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

усе круто

токо есть 2 где?????
1. там в zip файле есть лисп. он я так понял совсем проигнорирован ( я в смысле мне самому слепить из 2 файлов 1 или это не будет работать.)
2. в экселовском файле есть 2-ой листок с каталогом координат -это можно как то порешать.???

2-й лист в Экселе сделай сам - у тебя в руках уже
готовый инструмент (вспомогательные функции)
и алгоритм тоже (основная часть)
У меня нет времени на дальнейшее
Успехов

~'J'~

evg76 · 02.07.2009, 13:31

а по поводу 1 пункта

Олег (jr.) · 02.07.2009, 13:36

Цитата:

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

а по поводу 1 пункта

Ну нет времени совсем
Постарайся найти автора на форумах

~'J'~

Добавил 2 лист и форматирование. Все.

~'J'~

evg76 · 02.07.2009, 16:21

а можно сшить ваш лисп с моим.????

Олег (jr.) · 03.07.2009, 01:16

Цитата:

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

а можно сшить ваш лисп с моим.????

Не советую, не велика тяжесть запустить
2 лиспа поочередно
Я лично не люблю когда все в одном - где-то
глюкнет и все скопом насмарку
(сугубо IMHO конечно)

~'J'~

evg76 · 03.07.2009, 08:30

тогда надо команды менять а то 2 лиспа по одной команде.....

Олег (jr.) · 03.07.2009, 11:13

Цитата:

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

тогда надо команды менять а то 2 лиспа по одной команде.....

Господи так поменяй в моем лиспе к примеру в начале

Код:

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

(defun C:MDE (....)

- типа Межевые Данные в Эксель или
как оно там у вас называется

~'J'~

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

Код:

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

(vl-load-com)

(defun C:PX (/ acapp acsp adoc aexc cel col cols coords csht
	       item nwb points poly rang result row rows sht tmp wbks)
(setq aexc (vlax-get-or-create-object "Excel.Application")
      wbks (vlax-get-property aexc "Workbooks")
      nwb  (vlax-invoke-method wbks "Open" "C:\\File excel.xls");;<--change file name here
      sht  (vlax-get-property nwb "Sheets")
      csht (vlax-get-property sht "Item" 1)
      )

(vla-put-visible aexc :vlax-true)
(setq rang (vlax-invoke-method
	     (vlax-get-property aexc "Application")
	     "InputBox"
	     "Select Diapazone To Get Coordinates"
	     "Let you get a points"
	     nil
	     nil
	     nil
	     nil
	     nil
	     (vlax-make-variant 8 3))
      )
(setq rang (vlax-variant-value rang)
      )
(setq coords (vlax-get-property rang "Value2")
      )
(setq rows (vlax-get-property (vlax-get-property rang "Rows") "Count")
      )
(setq cols (vlax-get-property
	     (vlax-get-property rang "Columns")
	     "Count")
      )
(setq row 1)
(repeat	rows
  (setq col 1)
  (repeat cols
    (setq cel (vlax-variant-value
		(vlax-get-property
		  (vlax-get-property rang "Cells")
		  "Item"
		  (vlax-make-variant row vlax-vbLong)
		  (vlax-make-variant col vlax-vbLong))))
    (setq item (vlax-variant-value
		 (vlax-get-property cel "Value2"))
	  )
    (setq tmp (cons item tmp)
	  )
    (setq col (1+ col)
	  )
    )
  (setq	points (cons (reverse tmp) points)
	tmp    nil
	row    (1+ row)
	)
  )
(setq points (reverse points)
      points (apply 'append points)
      )

(vl-catch-all-apply
  (function (lambda ()
	      (vlax-invoke-method
		nwb
		"Close" :vlax-false)))
  )

(vl-catch-all-apply
  (function (lambda ()
	      (vlax-invoke-method
		aexc
		"Quit")))
  )
(mapcar	(function (lambda (x)
		    (vl-catch-all-apply
		      (function	(lambda	()
				  (progn
				    (vlax-release-object x)
				    (setq x nil)))))))
	(list rang csht nwb wbks aexc)
	)

(setq
  adoc (vla-get-activedocument
	 (setq acapp (vlax-get-acad-object))
	 )
  )
(if (= 1 (vlax-get-property adoc "Activespace"))
  (setq acsp (vla-get-modelspace adoc))
  (setq acsp (vla-get-paperspace adoc))
  )

(setq poly (vlax-invoke acsp "Add3DPoly" points)
      )
(vla-eval
  acapp
  (strcat
    "ThisDrawing.SetVariable \"USERI1\","
    "MsgBox (\"Close Polyline?\","
    "vbYesNo"
    ",\""
    "Answer this question:"
    "\")"
    )
  )
(if (= 6 (setq result (getvar "USERI1")))
  (vlax-put-property poly "Closed" :vlax-true)
  )
(vla-zoomextents acapp)
  
(gc)
(gc)
(princ)
  )
(prompt "\t\t***\t\nType PX to run program\t***")
(prin1)

Проверено в A2008 и MS Excel2003

~'J'~

evg76 · 03.07.2009, 16:07

не сочти за наглость
у меня в 2005 асаde выскочило
; error: bad argument type: VLA-OBJECT :vlax-false
или я чето не тоделаю

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

Цитата:

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

не сочти за наглость
у меня в 2005 асаde выскочило
; error: bad argument type: VLA-OBJECT :vlax-false
или я чето не тоделаю

Когда откроется файл Эксель с диалогом сначала нужно
выбрать диапазон с координатами - 2 или 3 столбца
затем кликнуть ОК
Добавил для LWPOLYLINE

Код:

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

(vl-load-com)

(defun C:PX (/ acapp acsp adoc aexc cel col cols coords csht
	       item nwb points poly rang result row rows sht tmp wbks)
(setq aexc (vlax-get-or-create-object "Excel.Application")
      wbks (vlax-get-property aexc "Workbooks")
      nwb  (vlax-invoke-method wbks "Open" "C:\\File excel.xls");;<--change file name here
      sht  (vlax-get-property nwb "Sheets")
      csht (vlax-get-property sht "Item" 1)
      )

(vla-put-visible aexc :vlax-true)
(setq rang (vlax-invoke-method
	     (vlax-get-property aexc "Application")
	     "InputBox"
	     "Select Diapazone To Get Coordinates"
	     "Let you get a points"
	     nil
	     nil
	     nil
	     nil
	     nil
	     (vlax-make-variant 8 3))
      )
(setq rang (vlax-variant-value rang)
      )
(setq coords (vlax-get-property rang "Value2")
      )
(setq rows (vlax-get-property (vlax-get-property rang "Rows") "Count")
      )
(setq cols (vlax-get-property
	     (vlax-get-property rang "Columns")
	     "Count")
      )
(setq row 1)
(repeat	rows
  (setq col 1)
  (repeat cols
    (setq cel (vlax-variant-value
		(vlax-get-property
		  (vlax-get-property rang "Cells")
		  "Item"
		  (vlax-make-variant row vlax-vbLong)
		  (vlax-make-variant col vlax-vbLong))))
    (setq item (vlax-variant-value
		 (vlax-get-property cel "Value2"))
	  )
    (setq tmp (cons item tmp)
	  )
    (setq col (1+ col)
	  )
    )
  (setq	points (cons (reverse tmp) points)
	tmp    nil
	row    (1+ row)
	)
  )
(setq points (reverse points))
(if (= 3 (length (car points)))
  (setq flag t)
  (setq flag nil)
  )
(setq points (apply 'append points)
      )

(vl-catch-all-apply
  (function (lambda ()
	      (vlax-invoke-method
		nwb
		"Close" :vlax-false)))
  )

(vl-catch-all-apply
  (function (lambda ()
	      (vlax-invoke-method
		aexc
		"Quit")))
  )
(mapcar	(function (lambda (x)
		    (vl-catch-all-apply
		      (function	(lambda	()
				  (progn
				    (vlax-release-object x)
				    (setq x nil)))))))
	(list rang csht nwb wbks aexc)
	)

(setq
  adoc (vla-get-activedocument
	 (setq acapp (vlax-get-acad-object))
	 )
  )
(if (= 1 (vlax-get-property adoc "Activespace"))
  (setq acsp (vla-get-modelspace adoc))
  (setq acsp (vla-get-paperspace adoc))
  )
  
(if flag
(setq poly (vlax-invoke acsp "Add3DPoly" points)
      )
(setq poly (vlax-invoke acsp "AddLightWeightPolyline" points)
      )
  )
(vla-eval
  acapp
  (strcat
    "ThisDrawing.SetVariable \"USERI1\","
    "MsgBox (\"Close Polyline?\","
    "vbYesNo"
    ",\""
    "Answer this question:"
    "\")"
    )
  )
(if (= 6 (setq result (getvar "USERI1")))
  (vlax-put-property poly "Closed" :vlax-true)
  )
(vla-zoomextents acapp)
  
(gc)
(gc)
(princ)
  )
(prompt "\t\t***\t\nType PX to run program\t***")
(prin1)

Простейший способ найти кокретную ошибку - это
загрузить код в редактор, добавить в самом конце
имя команды в скобках - в данном случае (C:PX)
там же в редакторе в меню Tools --> Load Text in Editor
загружаешь код на выполнение
Если выскочит ошибка ее можно посмотреть выделенной
в конкретной строке после того как в меню Debug нажать
Last Debug Source
Обычно я перед этим ставлю галочку на Break on Error
в меню Debug
~'J'~

evg76 · 06.07.2009, 08:59

или у меня руки кривые новыдает.
; error: unsupported argument type: nil

Олег (jr.) · 06.07.2009, 12:52

Цитата:

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

или у меня руки кривые новыдает.
; error: unsupported argument type: nil

На какой строке?
Вслепую ниего не могу сказать

~'J'~

evg76 · 06.07.2009, 13:33

в атокаде.
в экселе при запросе набираю A1;B1, эксел закрывается и в атокаде показывается строчка. Эксел в результате пустой.

Олег (jr.) · 06.07.2009, 16:28

Цитата:

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

в атокаде.
в экселе при запросе набираю A1;B1, эксел закрывается и в атокаде показывается строчка. Эксел в результате пустой.

В Экселе не надо ничего набирать - ты должен крестообразным курсором
только выделить нужный прямоугольный диапазон и нажать кнопку ОК

~'J'~

evg76 · 23.07.2009, 08:29

при наличии 2 объектов нумерация начинается с 1 это не есть гуд

Олег (jr.) · 28.07.2009, 21:43

Цитата:

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

Добрый день уважаемые !!!
Есть вопрос.
существует программка в лиспе по формированию координат в txt файл и геоданных в поле автокада, можно ли перетащить данные в эксель и так как это сделано в прилагаемом файле.
даннные в xls. файле были сделаны в vba(работает из пд экселя) но прога сырая и не всегда работает

либо же прикрутить lisp+vba

Окончательный вариант записи в Эксель - если кому интересно

~'J'~

evg76 · 14.08.2009, 14:07

спасибки

усе как надо.
а как насчет того чтобы склеить 2 лиспа в один или в последнем придумать с нумерацией

evg76 · 29.10.2013, 14:55

а можно ли это все заточить под автокад 12 и 10 офис

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
перенос настроек Автокада	МАА	AutoCAD	14	08.06.2011 21:30
Перенос данных из таблицы Автокада в Excel - дубль2	Таня.	AutoCAD	1	02.03.2009 16:08
Перенос таблицы Автокада в ...	RSD	AutoCAD	4	31.07.2006 15:43