Topic: xl2cad, please help if you have experience (mostly how to overcome it)

[alanjt]

i received a drawing (huge tree survey and topo), they tree description tables are strange blocks that i figured out are made with a program called XL2CAD http://www.dotsoft.com/xl2cad.htm i really need to get this information back out into either a text file, or preferably excel document. has anyone had any experience with this program, or have any ideas of how to overcome this. i called the company that provided the dwg and my received response was "the guy that did that is no longer with us". i don't think i'm going to get an actual excel document from them (he said he'd call me back tomorrow with all the information he could find).
if anyone can offer any help on how to remedy this situation, ANY suggestions would be greatly appreciated.

i've attached a block of some of the xl2cad created blocks.

[T.Willey]

Something like?  Remove the .txt extension, and open in excel

[alanjt]

oh man, that's pretty damn perfect tim!
how'd you do it?

[T.Willey]

I have a couple of routines that I used.  Once you explode the blocks ( after I copied one under the other ), they are just plain text.  Granted that the tree number is two different pieces of text, so I used one routine to combine those pieces of text.  Then I made sure they were all aligned with the top text string, because that is how my export text routine works.  Then I ran the export text routine, and got that csv file.  I noticed that some of the rows were messed up, but that should be an easy fix.

If this is something you are going to have to do a lot of, I can post the routines.

Oh, I'll post them anyways.  Let get all the subs, and see if they need to be cleaned up.  Some of my code, ones I don't think I will ever post, is not the bestest written.

[T.Willey]

Here is one of them.  Change the red part if it isn't combining all the text correctly; make the tolerance more.

Code: [Select]

(defun c:CombindText (/ AxisValue SpaceOpt ss Ent EntData EntList tmpList Str lst ActDoc)
    ; Combinds text with the same x or y value (user selected), and asks you what you want in bewteen
    ; the text strings.  Will keep the left most text if combinded by y value, and will keep
    ; the top most text if sorted by x value, the others get deleted.
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (if
        (and
            (not (initget "X Y"))
            (setq AxisValue
                (if (/= (getkword "\n  Combind text with same X or <Y> value: ") "X")
                    1
                    0
                )
            )
            (setq SpaceOpt (getstring T "\n Enter string to place in between text strings [enter for none]: "))
            (setq ss (ssget '((0 . "TEXT"))))
        )
        (progn
            (while (setq Ent (ssname ss 0))
                (setq EntData (entget Ent))
                (setq tmpList (list (trans (cdr (assoc 10 EntData)) 0 1) (cdr (assoc 1 EntData)) Ent))
                (vl-catch-all-apply
                    '(lambda ()
                        (foreach lst EntList
                            [color=red](if (equal (nth AxisValue (car tmpList)) (nth AxisValue (caar lst)) 0.001)[/color]
                                (progn
                                    (setq EntList (subst (cons tmpList lst) lst EntList))
                                    (exit)
                                )
                            )
                        )
                        (setq EntList (cons (list tmpList) EntList))
                    )
                )
                (ssdel Ent ss)
            )
        )
    )
    (foreach lst EntList
        (setq lst
            (if (equal AxisValue 0)
                (setq lst (vl-sort lst '(lambda (a b) (> (cadar a) (cadar b)))))
                (setq lst (vl-sort lst '(lambda (a b) (< (caar a) (caar b)))))
            )
        )
        (setq Str (cadar lst))
        (foreach lst2 (cdr lst)
            (setq Str (strcat Str SpaceOpt (cadr lst2)))
            (entdel (caddr lst2))
        )
        (setq EntData (entget (caddar lst)))
        (entmod (subst (cons 1 Str) (assoc 1 EntData) EntData))
        (entupd (caddar lst))
    )
    (vla-EndUndoMark ActDoc)
    (princ)
)

Here is the export routine.  Change red part if it isn't putting them in the right row; the second value of the 'rtos' call.

Code: [Select]

(defun c:ExportTextTable (/ tempPt XValList PtValList tempList tempStr EndList XValCnt StrCnt MaxCnt StrList Opened *error*)
   
    (defun *error* (msg)
   
        (if Opened (close Opened))
        (if msg (prompt (strcat "\n Error-> " msg)))
    )
    ;--------------------------------------------------------------
    (if (ssget '((0 . "TEXT")))
        (vlax-for obj (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-Acad-Object)))
            (setq tempPt
                (vlax-get
                    obj
                    (if (equal (vla-get-Alignment obj) 0)
                        'InsertionPoint
                        'TextAlignmentPoint
                    )
                )
            )
            (if (not (vl-position T (mapcar '(lambda (x) (equal (car tempPt) x 0.00001)) XValList)))
                (setq XValList (cons (car tempPt) XValList))
            )
            (setq PtValList
                (cons
                    (cons
                        (vl-string-translate "," ";" (vla-get-TextString obj))
                        tempPt
                    )
                    PtValList
                )
            )
        )
    )
    (foreach lst PtValList
        (if [color=red](setq tempList (assoc (setq tempStr (rtos (caddr lst) 2 10)) EndList))[/color]
            (setq EndList
                (subst
                    (list
                        tempStr
                        (cons lst (cadr tempList))
                    )
                    tempList
                    EndList
                )
            )
            (setq EndList (cons (list tempStr (list lst)) EndList))
        )
    )
    (if EndList
        (progn
            (setq EndList
                (vl-sort
                    EndList
                    '(lambda (a b)
                        (> (distof (car a)) (distof (car b)))
                    )
                )
            )
            (setq XValList (vl-sort XValList '<))
            (foreach lst EndList
                (setq lst
                    (vl-sort
                        (cadr lst)
                        '(lambda (a b)
                            (< (cadr a) (cadr b))
                        )
                    )
                )
                (setq XValCnt 0)
                (setq StrCnt 0)
                (setq MaxCnt (length XValList))
                (setq tempStr "")
                (repeat (length lst)
                    (while (not (equal (cadr (nth StrCnt lst)) (nth XValCnt XValList) 0.0000001))
                        (setq tempStr (strcat tempStr ","))
                        (setq XValCnt (1+ XValCnt))
                    )
                    (setq tempStr (strcat tempStr (car (nth StrCnt lst))))
                    (if (< StrCnt MaxCnt)
                        (setq tempStr (strcat tempStr ","))
                    )
                    (setq StrCnt (1+ StrCnt))
                    (setq XValCnt (1+ XValCnt))
                )
                (setq StrList (cons tempStr StrList))
            )
            (setq Opened (open "c:/test/ExportedText.csv" "w"))
            (foreach str (reverse StrList)
                (write-line str Opened)
            )
        )
    )
    (*error* nil)
    (princ)
)

Since it was mtext, you can just explode it because these routines only work with simple text.

And here is the one I use to line up text or attributes.

Code: [Select]

(defun c:lu(/ ActDoc Sel AliOpt AliPt MasterObj ObjList tempPt tempEnt)
    ; Lines up text, attribute definitions and attribute references.
   
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (if
        (and
            (or
                (initget "X Y")
                (if (setq Sel (nentsel "\n Select master text to align along X axis or <\"Y\"> to align along Y axis: "))
                    (cond
                        ((listp Sel)
                            (setq AliOpt "X")
                            (vl-position
                                (vla-get-ObjectName
                                    (setq MasterObj (vlax-ename->vla-object (setq tempEnt (car Sel))))
                                )
                                '("AcDbText" "AcDbAttributeDefinition" "AcDbAttribute")
                            )
                        )
                        ((= Sel "Y")
                            (setq AliOpt "Y")
                            (if (setq Sel (nentsel "\n Select master text to align along the Y axis: "))
                                (vl-position
                                    (vla-get-ObjectName
                                        (setq MasterObj (vlax-ename->vla-object (setq tempEnt (car Sel))))
                                    )
                                    '("AcDbText" "AcDbAttributeDefinition" "AcDbAttribute")
                                )
                            )
                        )
                    )
                )
            )
            (setq AliPt
                (trans
                    (if (equal (vla-get-Alignment MasterObj) 0)
                        (vlax-get MasterObj 'InsertionPoint)
                        (vlax-get MasterObj 'TextAlignmentPoint)
                    )
                    0
                    1
                )
            )
            (not (redraw tempEnt 3))
            (setq ObjList (SelAtts "Select attributes/text entities to line up: " T))
        )
        (foreach obj ObjList
            (setq tempPt
                (if (equal (vla-get-Alignment obj) 0)
                    (vlax-get obj 'InsertionPoint)
                    (vlax-get obj 'TextAlignmentPoint)
                )
            )
            (vlax-put
                obj
                (if (equal (vla-get-Alignment obj) 0)
                    'InsertionPoint
                    'TextAlignmentPoint
                )
                (trans
                    (list
                        (if (= AliOpt "X")
                            (car AliPt)
                            (car tempPt)
                        )
                        (if (= AliOpt "Y")
                            (cadr AliPt)
                            (cadr tempPt)
                        )
                        (caddr tempPt)
                    )
                    1
                    0
                )
            )
        )
    )
    (if tempEnt (redraw tempEnt 4))
    (vla-EndUndoMark ActDoc)
    (princ)
)
;----------------------------------------------
(defun SelAtts (Message bAllowText / Sel EntData Pt1 Pt3 gr p1 p2 p3 p4 po ss SelMode SelObjList flag)
; updated by gile @theSwamp.org to show the selection correctly.
; updated by T.Willey to allow the option to select text objects, not mtext
; updated by T.Willey, added new sub to see if the selection box and the bounding box of the objects
;    selected cross, so that a true crossing is simulated

(defun DoBoxesCross (PtList1 PtList2 / Intersect cnt cnt2)

(setq cnt 0)
(while
(and
(not Intersect)
(< cnt 4)
)
(setq cnt2 0)
(repeat 4
(if
(inters
(nth cnt PtList1)
(nth
(if (equal cnt 3)
0
(1+ cnt)
)
PtList1
)
(nth cnt2 PtList2)
(nth
(if (equal cnt2 3)
0
(1+ cnt2)
)
PtList2
)
T
)
(setq Intersect T)
)
(setq cnt2 (1+ cnt2))
)
(setq cnt (1+ cnt))
)
Intersect
)
;----------------------------------------------------------------------------------------------------
(defun GetAttSelection (ss SelMode / ObjList PtList TestList ll ur tempPtList SelObjList)

(foreach lst (ssnamex ss)
(cond
((equal (car lst) 3)
(setq ObjList (cons (vlax-ename->vla-object (cadr lst)) ObjList))
)
((equal (car lst) -1)
(foreach sub-lst (cdr lst)
(setq PtList (cons (cadr sub-lst) PtList))
)
)
)
)
(foreach obj ObjList
(cond
((= (vla-get-ObjectName obj) "AcDbBlockReference")
(foreach att (vlax-invoke obj 'GetAttributes)
(if
(and
(/= (vla-get-TextString att) "")
(= (vla-get-Invisible att) :vlax-false)
)
(progn
(setq TestList nil)
(vla-GetBoundingBox att 'll 'ur)
(setq tempPtList
(list
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(list (car ur) (cadr ll) (caddr ll))
(list (car ll) (cadr ur) (caddr ll))
)
)
(foreach pt tempPtList
(if
(and
(< (caar PtList) (car pt) (caadr PtList))
(< (cadar PtList) (cadr pt) (cadr (caddr PtList)))
)
(setq TestList (cons T TestList))
)
)
(if (= SelMode "Windowing")
(if (equal (length TestList) 4)
(setq SelObjList (cons att SelObjList))
)
(if
(or
TestList
(DoBoxesCross PtList tempPtList)
)
(setq SelObjList (cons att SelObjList))
)
)
)
)
)
)
(
(or
(= (vla-get-ObjectName obj) "AcDbText")
(= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
)
(if
(or
(/= (vla-get-TextString obj) "")
(and
(vlax-property-available-p obj 'TagString)
(/= (vla-get-TagString obj) "")
)
)
(progn
(setq TestList nil)
(vla-GetBoundingBox obj 'll 'ur)
(setq tempPtList
(list
(setq ll (safearray-value ll))
(setq ur (safearray-value ur))
(list (car ur) (cadr ll) (caddr ll))
(list (car ll) (cadr ur) (caddr ll))
)
)
(foreach pt tempPtList
(if
(and
(< (caar PtList) (car pt) (caadr PtList))
(< (cadar PtList) (cadr pt) (cadr (caddr PtList)))
)
(setq TestList (cons T TestList))
)
)
(if (= SelMode "Windowing")
(if (equal (length TestList) 4)
(setq SelObjList (cons obj SelObjList))
)
(if
(or
TestList
(DoBoxesCross PtList tempPtList)
)
(setq SelObjList (cons obj SelObjList))
)
)
)
)
)
)
)
SelObjList
)
;----------------------------------------------------------------------------------------------------
(defun gr-sel (/ loop gr pt)

(setq loop T)
(while (and (setq gr (grread T 12 2)) (/= (car gr) 3) loop)
(cond
((= (car gr) 5)
(setq pt (cadr gr))
)
(
(or
(member gr '((2 13) (2 32)))
(or (= (car gr) 11) (= (car gr) 25))
)
(setq loop nil
pt   nil
)
)
)
)
(if pt
(cond
((car (nentselp pt)))
(pt)
)
)
)
;---------------------------------------------------------------------------------------------------------
(setvar "ErrNo" 0)
(while
(and
(princ (strcat "\n" Message))
(setq sel (gr-sel))
)
(if (listp sel)
(progn
(setq p1  (list (car sel) (cadr sel))
pt1 (trans p1 1 2)
)
(princ "\nSpecify the opposite corner: ")
(while (and (setq gr (grread T 12 1)) (/= (car gr) 3))
(if (= 5 (car gr))
(progn
(redraw)
(setq pt3 (trans (cadr gr) 1 2)
p2 (trans (list (car pt3) (cadr pt1)) 2 1)
p3 (list (caadr gr) (cadadr gr))
p4 (trans (list (car pt1) (cadr pt3)) 2 1)
)
(if (< (car pt1) (car (trans p2 1 2)))
(progn
(setq SelMode "Windowing")
(grvecs (list 255 p1 p2 255 p2 p3 255 p3 p4 255 p4 p1))
)
(progn
(setq SelMode "Crossing")
(grvecs
(list -255 p1 p2 -255 p2 p3 -255 p3 p4 -255 p4 p1)
)
)
)
)
)
)
(redraw)
(if
(if bAllowText
(setq ss (ssget "_C" p1 p3 '((0 . "INSERT,TEXT,ATTDEF"))))
(setq ss (ssget "_C" p1 p3 '((0 . "INSERT"))))
)
(setq SelObjList (append SelObjList (GetAttSelection ss SelMode)))
)
)
(progn
(setq EntData (entget Sel))
(if
(or
(= (cdr (assoc 0 EntData)) "ATTRIB")
(and
bAllowText
(vl-position (cdr (assoc 0 EntData)) '("TEXT" "ATTDEF"))
)
)
(progn
(setq SelObjList
(cons (vlax-ename->vla-object Sel) SelObjList)
)
(redraw Sel 3)
)
)
)
)
(foreach att SelObjList
(redraw (vlax-vla-object->ename att) 3)
)
)
(foreach att SelObjList
(redraw (vlax-vla-object->ename att) 4)
)
SelObjList
)


[alanjt]

this is awesome. i will definitely get some use out of this. i'll be getting thing setup and working over the weekend so i can walk in monday and continue with my work.

thanks again.