myplace Posted December 16, 2005 Share Posted December 16, 2005 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... Quote Link to comment Share on other sites More sharing options...
myplace Posted December 18, 2005 Author Share Posted December 18, 2005 can some one help with this one... thanks.... Quote Link to comment Share on other sites More sharing options...
dbroada Posted December 18, 2005 Share Posted December 18, 2005 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. Quote Link to comment Share on other sites More sharing options...
myplace Posted December 18, 2005 Author Share Posted December 18, 2005 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 Quote Link to comment Share on other sites More sharing options...
dbroada Posted December 18, 2005 Share Posted December 18, 2005 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. Quote Link to comment Share on other sites More sharing options...
ASMI Posted December 18, 2005 Share Posted December 18, 2005 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.") Quote Link to comment Share on other sites More sharing options...
myplace Posted December 19, 2005 Author Share Posted December 19, 2005 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... Quote Link to comment Share on other sites More sharing options...
myplace Posted December 19, 2005 Author Share Posted December 19, 2005 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... Quote Link to comment Share on other sites More sharing options...
ASMI Posted December 19, 2005 Share Posted December 19, 2005 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 Quote Link to comment Share on other sites More sharing options...
myplace Posted December 20, 2005 Author Share Posted December 20, 2005 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 Quote Link to comment Share on other sites More sharing options...
myplace Posted December 20, 2005 Author Share Posted December 20, 2005 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... Quote Link to comment Share on other sites More sharing options...
ASMI Posted December 20, 2005 Share Posted December 20, 2005 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 Quote Link to comment Share on other sites More sharing options...
ASMI Posted December 21, 2005 Share Posted December 21, 2005 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 Quote Link to comment Share on other sites More sharing options...
myplace Posted December 21, 2005 Author Share Posted December 21, 2005 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... Quote Link to comment Share on other sites More sharing options...
myplace Posted December 21, 2005 Author Share Posted December 21, 2005 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 Quote Link to comment Share on other sites More sharing options...
ASMI Posted December 22, 2005 Share Posted December 22, 2005 Well I shall make as you want, but not today. I have a lot of work before holidays. Quote Link to comment Share on other sites More sharing options...
myplace Posted December 24, 2005 Author Share Posted December 24, 2005 no problem ... thanks... Quote Link to comment Share on other sites More sharing options...
ASMI Posted December 27, 2005 Share Posted December 27, 2005 >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") Quote Link to comment Share on other sites More sharing options...
myplace Posted December 29, 2005 Author Share Posted December 29, 2005 Hi.. this is super..what you have made for me... thanks... mario Quote Link to comment Share on other sites More sharing options...
myplace Posted December 29, 2005 Author Share Posted December 29, 2005 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.