a couple of point coordinates into a text file

Hi i.m using cad 2006.

i have a drawing that they use to set out pile into the fild with a totalstation

now i want to export the coordinates of de pile on the drawing to the total station with a text file. ( it's not one pile but many pile's )

can some one help me to do this with maybe a lisp or some command...

thanks...

can some one help with this one... thanks....

a little more detail please, I don't quite understand your problem.

Are the piles AutoCAD blocks?

What information are you wanting into the text file?

X,Y,Z for each pile?

Are you going to export information from every pile or select them from the screen?

If the problem is as I think, I would make a block then using a selection set (VBA as my languge of choice but equally easy from LISP) I would export X,Y,Z for each item in the selection set to a text file. All relatively simple but I don't have AutoCAD at home so could only "hint" at how to do it today.

HOi.. the piles ( they are blocks ) are marked with a cross where i can select the centre point of it.. and there i want the coord x,y, into a txt of excel file.

there are more than 20 piles on the drawing so i want them all in to the file

maybe there is a lisp routine for it.

so i can select the centre point of many points and he will put the x,y coords into the file.

i hope i have explaned it better...

thanks

I think so

As I said earlier I can't write the code at home but my code would be something like this (psudo code)

make a selection set of all blocks named "PILE"
for each block in selection set
  get insertion point
  write insertion point to "myFile.txt"
  loop

In other words, it looks relatively simple. If nobody does it for you today I'll give it a try tomorrow at work.

Try this. X and Y sorted coordinates of blocks insertion points writes to Excel file (in current UCS). You can preliminary select all blocks with name "PILE" by QSELECT.

(defun c:ptex(/ BLLIST BLSET CURCELL CURID CURLST
         CURORD CURROW CURVAL EXAPP EXFILE
         EXPATH EXSHEET EXSHEETS EXWORKBOOK
         OUTLIST OUTLST UTILOBJ SORTLST)
 
 (vl-load-com)
 
 (if
   (not
     (setq blSet(ssget "_I" '((0 . "INSERT")))))
     (progn
   (princ "\n*** Select blocks ***")
   (setq blSet(ssget '((0 . "INSERT"))))
   ); end progn
   ); end if
 (if blSet
   (progn
     (setq blList(mapcar 'vlax-ename->vla-object 
                   (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex blSet))))
       outList '()
       sortLst '()
       utilObj
        (vla-get-Utility
          (vla-get-ActiveDocument
        (vlax-get-acad-object)))
       ); end setq
       (foreach itm blList
         (setq curLst
            (vlax-safearray->list
              (vlax-variant-value
            (vla-TranslateCoordinates utilObj
                  (vla-get-InsertionPoint itm)
                acWorld acUCS :vlax-false)))
           sortLst(append sortLst(list curLst))
           ); end setq
         ); end foreach
       (setq sortLst(vl-sort sortLst
                   (function
                     (lambda(e1 e2)
                   (< (car e1) (car e2)))))
                   sortLst(vl-sort sortLst
                   (function
                     (lambda(e1 e2)
                   (and
                     (equal
                       (car e1)(car e2))
                     (<(cadr e1)(cadr e2))))))
             ); end setq
        (foreach itm sortLst
       (setq curOrd
            (strcat(rtos(car itm))", "(rtos(cadr itm)))
           outList(append outList(list curOrd))
           ); end setq
         ); end foreach
      (if (setq  exPath(getfiled "Save Text File As"
          (strcat (getvar "dwgprefix")(substr (getvar "dwgname") 1
       (- (strlen (getvar "dwgname")) 4)) ".xls")"xls" 33); end getfiled
           ); end setq
        (progn
   (setq exApp(vlax-create-object "Excel.Application"))
   (if(null exApp)
     (progn
       (alert "Error. Can't start MS Excel.")
       (quit)
       ); end progn
       ); end if
    (setq exWorkbook
              (vlax-get-property exApp "Workbooks")
          exFile
              (vlax-invoke-method exWorkbook "Add")
          exSheets
              (vlax-get-property exFile "Worksheets") 
              exSheet
              (vlax-get-property exSheets "Item" "Sheet1")
          curRow 1
   ); end setq
     (repeat(length outList)
       (setq curId(strcat "A"(itoa curRow))
         curCell(vlax-variant-value
                (vlax-invoke-method exSheet "Evaluate" curId))
         curVal(nth(1- curRow) outList)
         ); end setq
         (vlax-put-property curCell  "Formula" curVal)
       (vlax-release-object curCell)
       (setq curRow(1+ curRow))
       ); end repeat
     (vlax-invoke-method exFile "SaveAs" exPath nil nil nil nil nil nil)
     (vlax-invoke-method exFile "Close" nil)
     (vlax-invoke-method exApp "Quit")
   (mapcar(function(lambda(x)
          (if
        (and x(not(vlax-object-released-p x)))
        (vlax-release-object x)
        )
          ))
   (list curCell exSheet exSheets exFile exWorkbook exApp)
   )
   (setq curCell nil
         exSheet nil
         exSheets nil
         exFile nil
     exWorkbook nil
     exApp nil); end setq
   (gc)
   (princ(strcat"\n*** The file was successfully saved in: " exPath)) 
   ); end progn
        (princ "\n*** Excel file was not created! *** ")
        ); end if
   ); end progn
   (princ "\n*** Nothing blocks selected! ***")
 ); end if
     (princ)
     ); end of PTEX

(princ "\nType PTEX to run.")

Thanks for the help ..i'am trying it...

it look all abacadabra for me...

can i get the coord of the piles only that i selected or will he take it form all the piles

thanks...

it looks great... i have tryed it...

and i get a error message...

Command: _appload ptex.lsp successfully loaded.

Command:

Type PTEX to run.

Command:

Command: PTEX

*** Select blocks ***

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects: 1 found, 3 total

Select objects: 1 found, 4 total

Select objects: 1 found, 5 total

Select objects: 1 found, 6 total

Select objects: 1 found, 7 total

Select objects:

; error: Automation Error. Description was not provided.

Command:

Maybe you now what i did wrong ...

thanks

P.S. if you have written this specialie for me.....than it's fantastic...

What AutoCAD and MS Office version you use? Obviously problem in version MS Office... Try now simple 'on text screen' version of the program. It works? If it is necessary to add sorting of coordinates and record in *.txt a file I shall make it.

(defun c:ptx(/)
       (mapcar '(lambda(x)(princ
        (strcat "\n"(rtos(car x))","(rtos(cadr x)))))
        (mapcar 'cdr
         (mapcar '(lambda(x)(assoc 10 x))
          (mapcar 'entget
           (vl-remove-if 'listp 
                    (mapcar 'cadr(ssnamex
           (ssget '((0 . "INSERT"))))))))))
     (textscr)
 (princ)
 ); end  of c:ptx

i'm using autocad 2006 an office excel 2003...

It is not nessasary to sort... because the order that i select the blocks it the right order...

But when i get the error message... he hasn't written the file to harddisk...

thanks

i have tryed the lsp ...

and it look great.. but... i have compared the coord with the command point id. and i have a difference..

i looked it up..and it's the difference between my own ucs and the standaard one which came with the drawing from the constuctor

i have to use my own ucs coord because the constructor does not know my 0,0,0 point... for the total station

thanks...

Ok. With sorted coordinates in current UCS:

(defun c:ptx(/ blSet)
  (if
   (not
     (setq blSet(ssget "_I" '((0 . "INSERT")))))
     (progn
   (princ "\n*** Select blocks ***")
   (setq blSet(ssget '((0 . "INSERT"))))
   ); end progn
   ); end if
(if blSet
  (progn
    (mapcar '(lambda(x)
     (princ(strcat "\n"(rtos(car x))","(rtos(cadr x)))))
      (vl-sort
       (vl-sort
        (mapcar '(lambda(x)(trans x 0 1))
         (mapcar 'cdr
          (mapcar '(lambda(x)(assoc 10 x))
           (mapcar 'entget
            (vl-remove-if 'listp 
             (mapcar 'cadr(ssnamex blSet)))))))
   '(lambda(e1 e2)(and(equal(car e1)(car e2))
     (<(cadr e1)(cadr e2)))))
     '(lambda(e1 e2)(< (car e1) (car e2)))))
  (textscr)
   ); end progn
  ); end if
 (princ)
 ); end  of c:ptx

I have forgotten that sorting is not necessary. Without sorting in current UCS:

(defun c:ptx(/ blSet) 
  (if 
   (not 
     (setq blSet(ssget "_I" '((0 . "INSERT"))))) 
     (progn 
  (princ "\n*** Select blocks ***") 
  (setq blSet(ssget '((0 . "INSERT")))) 
  ); end progn 
   ); end if 
(if blSet 
  (progn
    (princ "\n++++ Coordinates list ++++\n")
      (mapcar '(lambda(x) 
       (princ(strcat "\n"(rtos(car x))","(rtos(cadr x))))) 
        (mapcar '(lambda(x)(trans x 0 1)) 
         (mapcar 'cdr 
          (mapcar '(lambda(x)(assoc 10 x)) 
           (mapcar 'entget 
            (vl-remove-if 'listp 
             (mapcar 'cadr(ssnamex blSet))))))))
    (princ "\n\n++++++ End of list ++++++")
  (textscr) 
   ); end progn 
  ); end if 
 (princ) 
 ); end  of c:ptx

thanks this one is working fine... also with my own ucs...

Sorry for asking after you did a lot of work to create this lsp for me.

But can you export them to an excel document...

i am using office pro 2003 - excel 2003 pro

thanks...

i am thinking in autocad 2006 there is the command id point where you can also get the coords of een specific point...

Is it possible to get this command into the lsp routine

than it hasn't to be a block to get the coord from..

thanks..

sorry for the lot of questions..

Gr..Mario

Well I shall make as you want, but not today. I have a lot of work before holidays.

no problem ...

thanks...

>myplace

Hi.

I have written for you the program which can save in *.txt a file of coordinate of picked points, points of an insert of blocks, points (entities) or vertexes of a polyline. Data from a text file can be then imported to MS Excel by means of: Data> Import External Data> Import Data... (Look pictures below).

(defun c:coords(/ cFile curPt filPath objSet
       oFlag oldMode ptLst sFlag)

 (defun PtCollect(SelSet)
   (mapcar '(lambda(x)(trans x 0 1)) 
          (mapcar 'cdr
       (mapcar '(lambda(x)(assoc 10 x)) 
        (mapcar 'entget
         (vl-remove-if 'listp 
                  (mapcar 'cadr(ssnamex SelSet)))))))
   ); end of PtCollect
   
 (if(not ptcol:mode)(setq ptcol:mode "Pick"))
 (initget "Pick pOints Blocks poLyline")
 (setq oldMode ptcol:mode
   ptcol:mode
    (getkword
     (strcat
       "\nSpecify mode [Pick/pOints/Blocks/poLyline] <"ptcol:mode">: "))
   ptLst '()
   ); end setq
 (if(null ptcol:mode)(setq ptcol:mode oldMode))
 (cond
   ((= "Pick" ptcol:mode)
    (setq curPt T)
    (while curPt
      (setq curPt
         (getpoint
           (strcat
        "\nPick point or Enter to continue > ")))
      (if curPt
    (setq ptLst(append ptLst(list curPt)))
    ); end if
      ); end while
    ); end condition #1
    ((= "pOints" ptcol:mode)
      (if
    (not(setq objSet(ssget "_I" '((0 . "POINT")))))
    (progn
      (princ "\nSelect points and press Enter ")
      (setq objSet(ssget '((0 . "POINT"))))
      ); end progn
    ); end if
      (if objSet
    (setq ptLst(PtCollect objSet))
    ); end if
     ); end condition #2
   ((= "Blocks" ptcol:mode)
      (if
    (not(setq objSet(ssget "_I" '((0 . "INSERT")))))
    (progn
      (princ "\nSelect blocks and press Enter ")
      (setq objSet(ssget '((0 . "INSERT"))))
      ); end progn
    ); end if
      (if objSet
    (setq ptLst(PtCollect objSet))
    ); end if
     ); end condition #3
   ((= "poLyline" ptcol:mode)
    (princ "\nSelect polyline and press Enter ")
      (if
    (setq objSet
       (ssget "_:S" '((0 . "*POLYLINE"))))
    (setq ptLst
       (mapcar '(lambda(x)(trans x 0 1))
        (mapcar 'cdr
         (vl-remove-if '(lambda(x)(/=(car x)10))
           (entget(ssname objSet 0)))))); end setq
    ); end if
    ); end condition #4
   ); end cond
 (if ptLst
   (progn
   (princ "\n+++++++ Coordinates list +++++++\n")
   (mapcar '(lambda(x) 
       (princ(strcat "\n"(rtos(car x))","(rtos(cadr x))
             (if(= 3(length x))(strcat ","(rtos(nth 2 x)))))))
       ptLst); end mapcar
   (princ "\n\n+++++++++ End of list +++++++++")
   (textscr)
   (initget "Yes No")
   (setq sFlag
      (getkword
        (strcat "\nSave coordinates to text file? [Yes/No] <Yes> : ")))
   (if(null sFlag)(setq sFlag "Yes"))
   (if
     (and
   (= "Yes" sFlag)
     (setq filPath(getfiled "Save Coordinates to Text File" 
          "Coordinates.txt" "txt" 33); end getfiled 
           ); end setq
   ); end and
     (progn
   (setq cFile(open filPath "w"))
   (foreach ln ptLst
     (write-line
       (strcat (rtos(car ln))","(rtos(cadr ln))
             (if(= 3(length ln))(strcat ","(rtos(nth 2 ln)))))
       cFile
       ); end write-line
     ); end foreach
   (close cFile)
   (initget "Yes No")
   (setq oFlag
          (getkword
        (strcat "\nOpen text file? [Yes/No] <No> : ")))
   (if(null oFlag)(setq oFlag "No"))
   (if(= oFlag "Yes")
     (startapp "notepad.exe" filPath)
     ); end if
   ); end progn
     ); end if
    ); end progn
   ); end if
 (graphscr)
 (princ)
 ); end of c:coords

(princ "\nType COORDS to run")

Hi.. this is super..what you have made for me...

thanks...

mario

hi .. have tryed it and it works super..

also the command that come on the screen with the menu's thanks..

i can't say it enough...

Mario