(vl-load-com)


(defun vk_WriteTextStream_XML (Stream FileName Charset / ADODBStreamObj Result)
  (if (setq ADODBStreamObj (vlax-create-object "ADODB.Stream"))
    (progn (setq Result	(vl-catch-all-apply
			  (function
			    (lambda ()
			      (vlax-put ADODBStreamObj "Charset" Charset)
			      (vlax-invoke ADODBStreamObj "Open")
			      (vlax-invoke-method ADODBStreamObj "WriteText" Stream 0)
			      (vlax-invoke ADODBStreamObj "SaveToFile" FileName 2)
			    )
			  )
			)
	   )
	   (vlax-release-object ADODBStreamObj)
	   (if (not (vl-catch-all-error-p Result))
	     FileName
	   )
    )
  )
)


;;;_____________________________________________________________________________________________________________
(defun c:Block*Text ( / RETLIST) ; Alle Text in den Blöcken
	(vlax-for 	BlocksItem
				(vla-get-blocks
					(vla-get-activedocument
						(vlax-get-acad-object)
					)
				)
				(vlax-for Item BlocksItem
					(if	(member	(vla-get-Objectname Item)' ( "AcDbText" "AcDbMText" )) ;
						(setq RetList
							(cons
								(list
									(vla-get-name BlocksItem)
									(vla-get-Handle BlocksItem)
									Item
									(vla-get-Handle Item)
									(vla-get-TextString Item)
								)
							RetList
							)
						)
					)
				)
	)
	(setq Block*TextListe RetList)
	(princ "\nTextobjekte in Blöcken: ")(princ (length RetList ))(princ "\n")(princ)
)

(defun c:Model*Text ( / RETLIST) ;alle Text im Modelbereich
	(setq 	ModelSpaceItem
				(vla-get-ModelSpace
					(vla-get-activedocument
						(vlax-get-acad-object)
					)
				)
	)
	(vlax-for Item ModelSpaceItem
		(if	(member	(vla-get-Objectname Item)' ( "AcDbText" "AcDbMText" )) ;
			(setq RetList
				(cons
					(list
						(vla-get-name ModelSpaceItem)
						(vla-get-Handle ModelSpaceItem)
						Item
						(vla-get-Handle Item)
						(vla-get-TextString Item)
					)
				RetList
				)
			)
		)
	)
	(setq Model*TextListe RetList )
	(princ "\nModelbereichstextobjekte: ")(princ (length RetList ))(princ)
)
(defun c:Paper*Text ( / RETLIST) ;alle Text im Papierbereich
	(setq 	PaperSpaceItem
				(vla-get-PaperSpace
					(vla-get-activedocument
						(vlax-get-acad-object)
					)
				)
	)
	(vlax-for Item PaperSpaceItem
		(if	(member	(vla-get-Objectname Item)' ( "AcDbText" "AcDbMText" )) ;
			(setq RetList
				(cons
					(list
						(vla-get-name PaperSpaceItem)
						(vla-get-Handle PaperSpaceItem)
						Item
						(vla-get-Handle Item)
						(vla-get-TextString Item)
					)
				RetList
				)
			)
		)
	)
	(setq Paper*TextListe RetList )
	(princ "\nPapierbereichstextobjekte: ")(princ (length RetList ))(princ)
)

(defun c:Textexport_XML ( /  AUSWAHL excelFILE FILE INDEX Inhalt)
	(if	(and 	(setq FILE (getfiled "TEXT-Export" "" "XML" 1 )) ;"C:\\" (getvar "dwgprefix")
				(setq excelFILE (strcat "\"" FILE "\"" ))      
		)
				(progn
	(c:Model*Text)
	(c:Paper*Text)
	(c:Block*Text)
	(setq Gesamt*TextListe (append Model*TextListe Paper*TextListe Block*TextListe ))
	(mapcar 	'(lambda (X) 
					(if	(= Inhalt nil )
						(setq Inhalt 	(strcat 
"<ROW>
<OBJECT_BEREICH>"	(nth 0 X ) "</OBJECT_BEREICH>
<OBJECT_HANDLE>"	(nth 3 X ) "</OBJECT_HANDLE>
<OBJECT_WERT>"		(nth 4 X ) "</OBJECT_WERT>
</ROW>\n"
										)
						)
						(setq Inhalt 	(strcat Inhalt 
"<ROW>
<OBJECT_BEREICH>"	(nth 0 X ) "</OBJECT_BEREICH>
<OBJECT_HANDLE>"	(nth 3 X ) "</OBJECT_HANDLE>
<OBJECT_WERT>"		(nth 4 X ) "</OBJECT_WERT>
</ROW>\n"
										)
						)
					)
				) 
				Gesamt*TextListe 
	)
	(setq Inhalt (strcat "<?xml version='1.0' encoding = 'UTF-8' ?>\n<DATA>\n" Inhalt "</DATA>" ))
	(vk_WriteTextStream_XML Inhalt FILE "UTF-8" )
	(command "shell" excelFILE )
				)
	)
 )
 
 
 
(defun C:Textimport_XML ( / )						;;;	(c:cad_internet)
			(if	(setq XMLfile (getfiled "TEXT-Import" (getvar "dwgprefix") "XML" 8 ))
				(progn	(setq	XMLListe	(vk_ReadXML	XMLfile )))
			)
	(setq ROW_laenge 	(vl-list-length (nth 2 (nth 1 XMLListe ))))
	(setq ROW_position ROW_laenge )
	(repeat ROW_laenge
		(setq 	ROW_position (- ROW_position 1 )
				ROW_zeile (nth 2 (nth ROW_position (nth 2 (nth 1 XMLListe ))))
				Handle_ (nth 2 (nth 1 ROW_zeile ))
				Wert_	(nth 2 (nth 2 ROW_zeile ))
		)
		(Model*Text_Import Handle_ Wert_ )
		(Paper*Text_Import Handle_ Wert_ )
		(Block*Text_Import Handle_ Wert_ )
	)
	
)


(defun Block*Text_Import ( Handle_ Wert_ / RETLIST) ; Alle Text in den Blöcken
     (vlax-for      BlocksItem
                    (vla-get-blocks
                         (vla-get-activedocument
                              (vlax-get-acad-object)
                         )
                    )
                    (vlax-for Item BlocksItem
                         (if     (= (vla-get-Handle Item) Handle_ ) ;vla-HandleToObject
                               (vla-put-TextString Item Wert_  )
                              (princ)
                         )
                    )
     )
)

(defun Model*Text_Import ( Handle_ Wert_ / RETLIST) ;alle Text im Modelbereich
	(setq 	ModelSpaceItem
				(vla-get-ModelSpace
					(vla-get-activedocument
						(vlax-get-acad-object)
					)
				)
	)
	(vlax-for Item ModelSpaceItem
		(if	(= (vla-get-Handle Item) Handle_ ) ;
			(vla-put-TextString Item Wert_  )
			(princ)
			)
	)
)

(defun Paper*Text_Import ( Handle_ Wert_ / RETLIST) ;alle Text im Papierbereich
	(setq 	PaperSpaceItem
				(vla-get-PaperSpace
					(vla-get-activedocument
						(vlax-get-acad-object)
					)
				)
	)
	(vlax-for Item PaperSpaceItem
		(if	(= (vla-get-Handle Item) Handle_ ) ;
			(vla-put-TextString Item Wert_  )
			(princ)
		)
		
	)
)



(defun JH:list>file	(symlist filename / fh) ;;;	(c:cad_internet)		;Aufruf = (JH:list>file 'liste1 "datei1.lsp") oder (JH:list>file '(liste1 liste2) "datei1.lsp")	
  (if	(setq fh	(open filename "w"	)	)
		(progn
		  (foreach sym	(if	(listp symlist)	symlist	(list symlist	))
			(princ "(setq " fh	)
			(princ sym fh		)
			(foreach item	(list	(cons	'quote	(list	(eval sym	))))
							(prin1 item fh	)
			)
			(princ ")" fh	)
		  )
		  (close fh	)
		)
		(princ"Datei konnte nicht geöffnet werden!\n")
	  )
)

(defun vk_ReadXML 	(	FileName 						;;;		(xml-liste-auswerten)
						/ 
						Doc ;OutList 
						*error*
					)
	(if (and 	FileName    ;;;	  (setq FileName (findfile FileName))
				(setq Doc 	(vlax-create-object "MSXML.DOMDocument"))
				(not (vlax-put Doc "async" 0))
				(if 	(= 	(vlax-invoke Doc "load" FileName) -1)
						t
						(prompt
							(strcat "\nError: "
								(vlax-get (vlax-get Doc "parseError") "reason")
							)
						)
				)
				(= (vlax-get Doc "readyState") 4)
		)
		(setq OutList (vk_XMLGetchildNodes (vlax-get Doc "firstChild")))
	)
	(and Doc (vlax-release-object Doc))
	(gc)
	OutList
;;; starte mit
;;;(vk_ReadXML (getfiled "" "" "xml" 16))
)

(defun vk_XMLGetchildNodes (Node /)						;;;			(vk_ReadXML)
	(princ (strcat "\n\n<< " (itoa (setq Modulzaehler (1+ Modulzaehler))) " \t<<<<<<<<<<<<<<<<<[Modul: vk_XMLGetchildNodes]>>>>>>>>>>>>>>>>>>>>>>>\n\n"))(princ)
	(if Node
		(if	(= (vlax-get Node "nodeType") 3)
			(vlax-get Node "nodeValue")
			(cons 	(list 	(vlax-get Node "nodeName")
							(vk_XMLGetAttributes Node)
							(vk_XMLGetchildNodes (vlax-get Node "firstChild"))
					)
					(vk_XMLGetchildNodes (vlax-get Node "nextSibling"))
			)
		)
	)
)

(defun vk_XMLGetAttributes (	Node 					;;;				(vk_XMLGetchildNodes)
								/ 
								Attributes 
								Attribute 
								OutList
							)
	(princ (strcat "\n\n<< " (itoa (setq Modulzaehler (1+ Modulzaehler))) " \t<<<<<<<<<<<<<<<<<[Modul: vk_XMLGetAttributes]>>>>>>>>>>>>>>>>>>>>>>>\n\n"))(princ)
	(if (setq Attributes (vlax-get Node "attributes"))
		(progn 	
				(while (setq Attribute (vlax-invoke Attributes "nextNode"))
					(setq OutList 	(cons 	(cons 	(vlax-get Attribute "nodeName")
													(vlax-get Attribute "nodeValue")
											)
										OutList
									)
					)
					(vlax-release-object Attribute)
				)
				(vlax-release-object Attributes)
				(reverse OutList)
		)
	)
)