Author Topic: CSV out Help  (Read 2799 times)

0 Members and 1 Guest are viewing this topic.

johnratliff

  • Guest
CSV out Help
« on: March 21, 2014, 02:45:42 PM »
I'm not very literate with lisp.

I'm trying to get plain text BOM's a 1,000 plus drawings into excel.

I nicked this from a couple of threads. The routine will work fine for single text. It throws a "," and the end of the text. but I have text strings. Can someone help me to put in a "," where there is more than one space " " in the text? I've attached a sample test drawing. Looking at it I'll have to change the deliminator to something else because there are also comas in the description field.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test (/ tempPt XValList PtValList tempList tempStr EndList XValCnt StrCnt MaxCnt StrList Opened fn *error*)
  2.  
  3. (defun *error* (msg)
  4.  
  5. (if Opened (close Opened))
  6. (if msg (prompt (strcat "\n Error-> " msg)))
  7. )
  8. ;--------------------------------------------------------------
  9. (if (ssget '((0 . "TEXT")))
  10. (setq tempPt
  11. obj
  12. 'InsertionPoint
  13. 'TextAlignmentPoint
  14. )
  15. )
  16. )
  17. (if (not (vl-position T (mapcar '(lambda (x) (equal (car tempPt) x 0.00001)) XValList)))
  18. (setq XValList (cons (car tempPt) XValList))
  19. )
  20. (setq PtValList
  21. tempPt
  22. )
  23. PtValList
  24. )
  25. )
  26. )
  27. )
  28. (foreach lst PtValList
  29. (if (setq tempList (assoc (setq tempStr (rtos (caddr lst) 2 10)) EndList))
  30. (setq EndList
  31. tempStr
  32. (cons lst (cadr tempList))
  33. )
  34. tempList
  35. EndList
  36. )
  37. )
  38. (setq EndList (cons (list tempStr (list lst)) EndList))
  39. )
  40. )
  41. (if EndList
  42. (setq EndList
  43. EndList
  44. '(lambda (a b)
  45. (> (distof (car a)) (distof (car b)))
  46. )
  47. )
  48. )
  49. (setq XValList (vl-sort XValList '<))
  50. (foreach lst EndList
  51. (setq lst
  52. (cadr lst)
  53. '(lambda (a b)
  54. (< (cadr a) (cadr b))
  55. )
  56. )
  57. )
  58. (setq XValCnt 0)
  59. (setq StrCnt 0)
  60. (setq MaxCnt (length XValList))
  61. (setq tempStr "")ad
  62. (repeat (length lst)
  63. (while (not (equal (cadr (nth StrCnt lst)) (nth XValCnt XValList) 0.0000001))
  64. (setq tempStr (strcat tempStr ","))
  65. (setq XValCnt (1+ XValCnt))
  66. )
  67. (setq tempStr (strcat tempStr (car (nth StrCnt lst))))
  68. (if (< StrCnt MaxCnt)
  69. (setq tempStr (strcat tempStr ","))
  70. )
  71. (setq StrCnt (1+ StrCnt))
  72. (setq XValCnt (1+ XValCnt))
  73. )
  74. (setq StrList (cons tempStr StrList))
  75. )
  76. (setq pa (getvar "DWGPREFIX"))
  77. (setq fn (strcat (vl-filename-base (getvar "DWGNAME")) ".txt"))
  78. (setq tp (strcat pa fn))
  79. (setq Opened (open tp "a"))
  80. (foreach str (reverse StrList)
  81. (write-line str Opened)
  82. )
  83. )
  84. )
  85. (*error* nil)
  86. )

ronjonp

  • Needs a day job
  • Posts: 7526
Re: CSV out Help
« Reply #1 on: March 21, 2014, 04:15:11 PM »
Give this a try  :)
Code: [Select]
(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)
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

johnratliff

  • Guest
Re: CSV out Help
« Reply #2 on: March 24, 2014, 10:14:46 AM »
 :kewl:

Cheers!

ronjonp

  • Needs a day job
  • Posts: 7526
Re: CSV out Help
« Reply #3 on: March 24, 2014, 11:54:46 AM »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC