0 Members and 1 Guest are viewing this topic.
(defun c:test (/ *error* _spaces2comma ad endlist fn maxcnt opened pa ptvallist strcnt strlist templist temppt tempstr tp x xvalcnt xvallist ) ;; RJP added (defun _spaces2comma (string / _foo i) (defun _foo (string) (vl-string-right-trim " " (vl-string-left-trim " " string))) (if (vl-string-search " " string) (while (setq i (vl-string-search " " string)) (setq string (strcat (_foo (substr string 1 (1+ i))) "," (_foo (substr string (1+ i))))) ) string ) (vl-string-right-trim "," string) ) ;; (_spaces2comma " test 12 3 4 5,") (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 (setq templist (assoc (setq tempstr (rtos (caddr lst) 2 10)) endlist)) (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 "") ad (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 pa (getvar "DWGPREFIX")) (setq fn (strcat (vl-filename-base (getvar "DWGNAME")) ".txt")) (setq tp (strcat pa fn)) (setq opened (open tp "a")) (foreach str (reverse strlist) (write-line (_spaces2comma str) opened)) ) ) (princ))
:kewl: Cheers!