[flareon]

Здравствуйте! На работе поставили специфическую задачу...Имеется некий файл dwg. с канализационными колодцами, у каждого по три подписи (отм. верха, тр. и дна), так вот, начальство хочет чтоб я приподнес им все это в Excell таким образом, чтоб эти подписи появились неким чудным образом там в виде таблички Есть хоть какое-нибудь спасение от надвигающегося онанизма?
P.s колодцев 320 штук!!!!!!!!!!!!
кусочек файла прилагается...

[Шмяк]

Кажется есть.Вчера распечатывал ПДФ файл.И случайно экспортировал из него только текст.Какк сделал не помню.Но файлик получился отдельный.А отдельные цифры ужо в ексель перебросить проще.
О !!! Он даж сохранился.В блокноте.Тоько форум его не хочет брать.

[357]

Сообщение от flareon Есть хоть какое-нибудь спасение от надвигающегося онанизма?

[Alexeipost]

Имеющимися средствами некоторых нудных действий не избежать.
Попробовал с помощью извлечения данных.
1. Удалить повторяющиеся элементы (цифры у колодцев дублируются. "N75" - не дублируется, а вот те цифры, что к относятся к колодцы, их в одной точке по две штуки.)
2. Надо выделить все примитивы "текст" и сделать выравнивание "влево".
3. Далее выделять номер колодца и цифры (примитивы "текст"), которые привязаны к этому колодцы и в графе "Положение Z" (у всех сразу) указывать номер колодца. (Всего 320 значений).
4. С помощью извлечения данных извлечь в эксель примитивы Текст со значениями "Положение Z" и "Значение" (сортировку по "Положение Z" не забудь).
5. Далее в экселе доработать напильником)))

[Олег (jr.)]

Проверяй сам:

Код:

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

 ;;------------------------------------------------------------------------------------

(defun C:KOL(/ *error*  a b c col data dirty_list en et num obj pos pt_list record_list
	     row sorted_list sset tmpss tmp_list txtobj x xlapp xlbook xlbooks xlcells
	     xlrange xlsheet xlsheets y)
  
(defun *error* (msg)
  (if
    (vl-position
      msg
      '("console break"
	"Function cancelled"
	"quit / exit abort"
       )
    )
     (princ "Error!")
     (princ msg)
  )

  (princ)
)

  ;;;local defuns
(defun setcelltext(cells row column value)
  (vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
	 (vlax-make-variant
	   (vl-princ-to-string value) 8)))
  )
;; Credits to gile ;;
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)
  
(command "_zoom" "_e")
  (if (setq sset (ssget  "_X" '((0 . "lwpolyline")(8 . "К-1")(62 . 26))))
    (progn
      (setq data nil)
      (setvar 'dimzin 0)
(while (setq en (ssname sset 0))
	(setq obj  (vlax-ename->vla-object en))	     
         (vla-getboundingbox obj 'a 'b)
  (setq a (vlax-safearray->list a)
	b (vlax-safearray->list b)
	c (mapcar '(lambda (x y) ( / (+ x y ) 2.))a b)
	pt_list (list
		  (list (- (car c) 10)(- (cadr c) 10))
		  (list (+ (car c) 10)(- (cadr c) 10))
		  (list (+ (car c) 10)(+ (cadr c) 10))
		  (list (- (car c) 10)(+ (cadr c) 10)))
	tmpss (ssget "_WP" pt_list '((0 . "text")(7 . "Standard")(-4 . "<or")(40 . 1.5)(40 . 2.5)(-4 . "or>"))))
  (if tmpss
    
	(while (setq et (ssname tmpss 0))
	(setq txtobj  (vlax-ename->vla-object et))	
(setq tmp_list (cons (list  (vlax-get txtobj 'insertionpoint )(vlax-get txtobj 'textstring )) tmp_list))	  
	  (ssdel et tmpss)
	  )
  )
(if (setq pos (vl-position t (mapcar '(lambda (x)(wcmatch (last x) "N#*")) tmp_list)))
  (progn
    (setq num (nth pos tmp_list))
(setq dirty_list (vl-remove num tmp_list))
(setq sorted_list (append (list num) (vl-sort dirty_list '(lambda (n m)
				   (< (cadr (car n))(cadr (car m)))
				      
				      )
			    )
		    )
      )
(setq record_list  (remove_doubles (mapcar '(lambda(x)(cadr x)) sorted_list)))
    (setq data (cons record_list data))
    
)
  )
(setq tmp_list nil dirty_list nil sorted_list nil record_list nil)
  (ssdel en sset)
    )
)
   
)
  (if data
(setq data (vl-sort data '(lambda (n m)
				   (< (atof (vl-string-translate  "N" "9." (car n)))(atof(vl-string-translate  "N" "9." (car m))))
				      (< (car n)(car m))
				      )
			    )
    )
    )
  (alert "Ждите завершения...\nФайл Excel сохранить вручную")
  (setq	xlapp	   (vlax-get-or-create-object "Excel.Application")
	xlbooks  (vlax-get-property xlapp 'Workbooks)
	xlbook	   (vlax-invoke-method xlbooks 'Add)
	xlsheets (vlax-get-property xlbook 'Sheets)
	xlsheet	   (vlax-get-property xlsheets 'Item 1)
	xlcells	   (vlax-get-property xlsheet 'Cells)
	)
  
  
(vla-put-visible xlapp :vlax-true)
(vl-catch-all-apply 'vlax-put-property (list xlapp 'ScreenUpdating :vlax-false))
(setq row 1)
(foreach item data
  (setq col 1)
  (foreach a item
    ;;(setcelltext xlcells row col (strcat "'" a));<-- если не поддерживает локальные настройки
    (setcelltext xlcells row col a)
    (setq col (1+ col))
  )
  (setq row (1+ row))
)

(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlsheet 'usedrange)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'Select))
(setq xlrange (vl-catch-all-apply 'vlax-get-property (list xlapp 'selection)))
(vl-catch-all-apply 'vlax-invoke-method (list xlrange 'borderaround nil nil nil nil))
(vl-catch-all-apply 'vlax-put-property (list xlapp 'screenupdating :vlax-true))
 ( vl-catch-all-apply 'vlax-put-property (list
   (vlax-get-property xlrange 'columns)
   'numberformat "#0.00"))
  (vlax-invoke-method
   (vlax-get-property xlrange 'columns)
   'autofit)

;;;(setq fname (strcat (getvar "dwgprefix")(vl-string-right-trim ".dwg" (getvar "dwgname"))))
;;;
;;;(vlax-invoke-method
;;;    xlbook
;;;    'SaveAs
;;;    fname 
;;;    -4143
;;;    nil
;;;    nil
;;;    :vlax-false
;;;    :vlax-false
;;;    1
;;;    2
;;;  )
;;;(vlax-invoke-method
;;;    xlbook 'Close)
;;;(vlax-invoke-method
;;;    xlapp 'Quit)
  (mapcar '(lambda (x)
	     (vl-catch-all-apply
	       '(lambda	()
		  (vlax-release-object x)
		)
	     )
	   )
	  (list xlcells xlsheet xlsheets xlbook xlbooks xlapp)
  )
  (setq  xlapp nil)
  (gc)(gc)(gc)
 
  (*error* nil)
  (princ)
  )
(prompt "\n\t\t***\tКоманда для выполнения: KOL\t***\n")
(princ)

(or (vl-load-com)
    (princ)     )

;;------------------------------------------------------------------------------------

[flareon]

Огромное спасибо всем неравнодушным! Все советы работают на "ура"!!! Олег, тебе отдельный respect! Код пашет без всяких проволочек (у меня 2012-й). Успехов всем!

[Mr.AS]

ребята а как надо пользоватся кодом ?

[Кулик Алексей aka kpblc]

http://dwg.ru/pub/9

[Mek]

Ватокад 2010. Код из сообщения №5 не работает
Команда: kol
Неизвестная команда "KOL". Для вызова справки нажмите F1.

Команда: (kol)
; ошибка: no function definition: KOL

При вставке в блокнот форматирование сбилось в кучу, получилось не так красиво как оформлено в сообщении №5..
Что делать?

Добавлено:
Извлечение данных зачем-то сортирует по возрастанию (или убыванию).
Зачем оно сортирует, как отключить?
Мне сортировать не надо, надо чтобы было как есть(

[Кулик Алексей aka kpblc]

Как копировал-то? По аналогии с

LoadLispFromDWGRubyOpera.wmv

http://www.youtube.com/watch?v=wFKc6EfRofo ?

[VVA]

Mek, Значение текста прекрасно извлекается с помощью _dataextraction

[Олег (jr.)]

Сообщение от Mek Ватокад 2010. Код из сообщения №5 не работает ................. Извлечение данных зачем-то сортирует по возрастанию (или убыванию). (

Если не работает какого х..на тогда сортирует?

-'o'-

[Mek]

Сообщение от Кулик Алексей aka kpblc Как копировал-то?

Нажал на кнопку слева "Выделить всё", затем справа нажал Копировать в буфер..

Сообщение от Олег Если не работает какого х..на тогда сортирует?

Сортирует "Извлечение данных" - в ватокаде такая команда: Сервис/Извлечение данных..

Сообщение от VVA Значение текста прекрасно извлекается с помощью _dataextraction

Если несколько текстов - то эта команда сортирует их, либо по возрастанию либо по убыванию.
А мне не надо сортировать(

ДОБАВЛЕНО:
Во, щас по-человечьи вставилось.. Лисп загрузился.
Но открывает пустой файл Эксель - текст не вставляет..

[jon73]

Здравствуйте , когда то давно Спецы с форума помогли мне и состряпали лист который путем выделения множества текстов на чертежах выводит это все списком в таблицу экселя... но вот в новых версиях автокада эта функция копирования автоматом в буфер экселя перестала работать прога зависает , что можно сделать в этом случае???????

Код:

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

 ;;Tony Tanzillo
;;http://discussion.autodesk.com/threa...hreadID=582410
;;Edited by VVA
;;http://www.autocad.ru/cgi-bin/f1/board.cgi?t=36360lW
;; Given the list (1 2 1 1 3 2 5 3 4 5 3),
;;
;; (combine (1 2 1 1 3 2 5 3 4 5 3) '> '= )
;;
;; returns ((1 1 1) (2 2) (3 3 3) (4) (5 5))
;;
;; The input list does not need to be atoms,
(defun C:RDT ( / combine sort REPORT-DUPLICATE-TEXT)
(defun copyToclipboard ( str / ieobj)
  (setq ieobj (vlax-get-or-create-object
                      "InternetExplorer.Application"
                      )
             )
 (vlax-invoke ieobj 'navigate2 "about:blank")
 (vlax-invoke
(vlax-get (vlax-get (vlax-get ieobj 'document) 'parentwindow)
'clipboarddata
)
'setdata
"text"
str
)
(vlax-release-object ieobj)
  )
(defun combine (inlist is-greater is-equal / sorted current result)
  (setq sorted (sort inlist is-greater))
  (setq current (list (car sorted)))
  (foreach item (cdr sorted)
    (if (apply is-equal (list item (car current)))
      (setq current (cons item current))
      (progn
        (setq result (cons current result))
        (setq current (list item))
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach
  (cons current result)
) ;_ end of defun
(defun sort (lst predicate)
  (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
) ;_ end of defun
;; simplified example for TEXT only (no MTEXT)
(defun REPORT-DUPLICATE-TEXT (/ ss items i e)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq items
               (cons
                 (cons
                   e
                   (strcase (vl-string-trim " " (cdr (assoc 1 (entget e)))))
                 ) ;_ end of cons
                 items
               ) ;_ end of cons
        ) ;_ end of setq
      ) ;_ end of repeat
      (setq items
             (combine items
                      '(lambda (a b)
                         (> (cdr a) (cdr b))
                       ) ;_ end of lambda
                      '(lambda (a b)
                         (eq (cdr a) (cdr b))
                       ) ;_ end of lambda
             ) ;_ end of combine
      ) ;_ end of setq
      (textscr)
      (princ "\n\n")
      (setq e (mapcar '(lambda(item)(strcat "\nЗначение: " (cdar item) " — количество=" (itoa (length item)))) items))
      (mapcar 'princ e)    
      (setq e (apply 'strcat e))
      (copyToclipboard e)
      (princ "\nСкопирвоано в clipboard")
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(vl-load-com)
 (REPORT-DUPLICATE-TEXT)
)
(princ "\nНаберите RDT в командной строке")

;^C^C(if (null C:rdt)(mi_load "mip_all"));rdt;

[VVA]

jon73, Попрбуй заменить ф-цию copyToclipboard на эту

Код:

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

;|
;  ! ***************************************************************************
;; !                           copyToclipboard
;; ! ***************************************************************************
;; ! Function : Copy text to clipboard
;; ! Argument : 'str'     - String
;; ! Returns  : nil
;; see http://www.theswamp.org/index.php?topic=21764.new
;; ! ****************************************************************************

(defun copyToclipboard ( text / htmlfile result)
 (setq result
        (vlax-invoke
            (vlax-get
                (vlax-get
                    (setq htmlfile (vlax-create-object "htmlfile"))
                   'ParentWindow
                )
               'ClipBoardData
            )
           'SetData
            "Text"
            text
        )
    )

    (vlax-release-object htmlfile)
    result
)

[jon73]

Спасибо! а эту функцию вставить в предыдущий код и запускать по старому rtd ? как правильно совместить???

[VVA]

Сообщение от jon73 как правильно совместить???

Совмещал в блокноте без проверки. Должно работать

[jon73]

Спасибо все работает это программа - Бомба очень помогает в создании спецификаций . Спасибо!