Author Topic: [challenge ] A36 create a list of text lines table  (Read 674 times)

0 Members and 1 Guest are viewing this topic.

BIGAL

  • Swamp Rat
  • Posts: 1037
  • 40 + years of using Autocad
[challenge ] A36 create a list of text lines table
« on: March 21, 2022, 10:43:21 PM »
The question is there a simple way of doing a double sort on a Line and text type 'table' object. We have columns of text and lots of linework, one solution is to look at the lines and retrieve the text within the box. COT_Convert_Old_TableV1.4 But then I have to read the table for what I want.

Yes a sort will return a X & Y list if we window all the text the desirable way, but need the list to be in a by rows list, look at excel ((a1 b1 c1 c2 c3 ....)(a2 b2 b3.... ))ok you say easy now for the tricky bit when you look at the  Y value of say 2 text get 123.456 the other is 123.477 a minute difference so y1 /= y2 so it needs to use equal not = with a tolerance.

A sample dwg is attached. Actual project say 800 rows. Note the 1st & 2nd rows are not required and have a check in code which should remove anyway.
 
I have looked through the challenges trying to find a match but if its there and I have missed please let me know.
A man who never made a mistake never made anything

ronjonp

  • Needs a day job
  • Posts: 7437
Re: [challenge ] A36 create a list of text lines table
« Reply #1 on: March 22, 2022, 12:01:33 AM »
How is this different than the sort top to bottom, left to right code out there?

Windows 11 x64 - AutoCAD /C3D 2022

Custom Build PC

JohnK

  • Administrator
  • Seagull
  • Posts: 10140
Re: [challenge ] A36 create a list of text lines table
« Reply #2 on: March 22, 2022, 08:47:46 AM »
This sounds like an actual need; people can get cranky when an actual need is posted as a "challenge". Should I move this post to the AutoLisp forum?
TheSwamp.org (serving the CAD community since 2003)

Donate to TheSwamp.org

kirby

  • Newt
  • Posts: 110
Re: [challenge ] A36 create a list of text lines table
« Reply #3 on: March 22, 2022, 02:59:46 PM »
Lunchtime diversion, so no crankiness here.

No fuzz sorting or k-means clustering, just assume that rows follow an approximately even spacing (but columns seldom do due to text width).

Other caveats listed in code.  Most significantly, gaps in table entries are not handled.

Enhancement could be to supply a vector instead of Row spacing (Yspace), then use the vector to transform coordinates for table with rotation.

Code - Auto/Visual Lisp: [Select]
  1. (defun C:TestTGTL ( / SET0 DataList CNT MyEnt MyEntData EntType YSpace)
  2. ; Test routine for 'TextGridToList' aka Challenge A36
  3. ; KJM - March 2022
  4. ; Leave 'Ans' as global
  5.  
  6. ; Get bunch of text items
  7. (prompt "\nSelect text entities, omitting any headers...")(princ)
  8. (setq SET0 (ssget))
  9. (setq DataList nil)
  10.  
  11. (setq CNT 0)
  12.         (setq MyEnt (ssname SET0 CNT))
  13.         (setq MyEntData (entget MyEnt))
  14.         (setq EntType (strcase (cdr (assoc 0 MyEntData))))
  15.        
  16.         (if (member EntType (list "TEXT" "MTEXT"))
  17.                 (setq DataList (cons MyEnt DataList))
  18.         )
  19.        
  20.         (setq CNT (1+ CNT))
  21. ) ; close repeat       
  22.  
  23. (if DataList
  24.   (progn
  25.         (setq Yspace (getdist "\nSelect row spacing..."))
  26.        
  27.         (setq Ans (TextGridToList DataList YSpace 0))
  28.         (setq CNT 0)
  29.         (repeat (length Ans)
  30.                 (prompt "\n")(princ (nth CNT Ans))(princ)
  31.                 (setq CNT (1+ CNT))
  32.         ) ; close repeat       
  33.   )
  34. ) ; close if
  35.  
  36. ; Next steps:
  37. ;       use Lee Mac's 'LM:writecsv' to write to CSV
  38. ;       or use Fixo's Excel library to write directly into Excel
  39.  
  40. (prompt "\nCompleted!")(princ)
  41. )
  42.  
  43.  
  44.  
  45.  
  46.  
  47. (defun TextGridToList (MyList YSpace RetCode /
  48.                                 TextEntList CNT MyItem CNT1 MyItem1 MyEnt MyEntData EntType TextString X Y MyLayer XMin XMax YMin YMax
  49.                                 S1 S2 NumItems NumRows RowList Index OutList OutList1
  50.                                 )
  51. ; Challenge A36 - Convert a number of text entities in grid format to 2D list or list of CSV entries
  52. ; KJM - March 2022
  53. ; Input:
  54. ;       MyList - (list or enames)
  55. ;       YSpace - (real) typical row spacing (basis: table columns may differ but rows ususully have consistent spacing)
  56. ;       RetCode - (integer) code indicating what to return
  57. ;                       0 or nil = return list of text strings only
  58. ;                       1 = return list of sublists of (0-Ename 1-TextString 2-X 3-Y 4-layer), may be useful for Excel <--> Acad conversion
  59. ; Returns:
  60. ;       list of text values with rows as sublists ((row0) (row1) (row2)...)
  61. ; Uses custom functions:
  62. ;       Replace1
  63. ; Notes and Assumptions:
  64. ;       Uses 'simple' Text or single item Mtext entities, not a table or multiline Mtext
  65. ;       table is orthagonal and aligned with X and Y axes
  66. ;       table is in plan view, Z coordinate not considered
  67. ;       Gaps in data not handled (just return a fewer number of items in row sublists)
  68.  
  69. ; defaults
  70. (if (not RetCode) (setq RetCode 0))
  71.  
  72. ; Build list of (0-Ename 1-TextString 2-X 3-Y 4-layer) and get minimum and maximum X,Y values
  73. (setq TextEntList nil)
  74.  
  75. (setq CNT 0)
  76. (repeat (length MyList)
  77.         (setq MyEnt (nth CNT MyList))
  78.         (setq MyEntData (entget MyEnt))
  79.        
  80.         (setq EntType (strcase (cdr (assoc 0 MyEntData))))
  81.         (if (member EntType (list "TEXT" "MTEXT"))
  82.           (progn
  83.                 ; Only add text
  84.                 (setq TextString (cdr (assoc 1 MyEntData)))     ; multiline Mtext not accommodated
  85.                 (setq X (car (cdr (assoc 10 MyEntData))))
  86.                 (setq Y (cadr (cdr (assoc 10 MyEntData))))
  87.                 (setq MyLayer (cdr (assoc 8 MyEntData)))        ; don't need this, but may want to add separation by layer
  88.                
  89.                 ; Build list
  90.                 (setq TextEntList (cons (list MyEnt TextString X Y MyLayer) TextEntList))
  91.  
  92.                 ; Get min and max X, Y
  93.                 (if (eq CNT 0)
  94.                   (progn
  95.                         ; Initialize min and max
  96.                         (setq XMin x)
  97.                         (setq XMax X)
  98.                         (setq YMin Y)
  99.                         (setq YMax Y)
  100.                   )    
  101.                 )
  102.                
  103.                 ; Update min and max
  104.                 (if (< X XMin) (setq XMin X))  
  105.                 (if (> X XMax) (setq XMax X))  
  106.  
  107.                 (if (< Y YMin) (setq YMin Y))  
  108.                 (if (> Y YMax) (setq YMax Y))                  
  109.  
  110.           )    
  111.         ) ; close if
  112.        
  113.         (setq CNT (1+ CNT))
  114. ) ; close repeat       
  115.  
  116. ; Sort by Y (not needed)
  117. ;(setq TextEntList (vl-sort TextEntList '(lambda (S1 S2) (< (nth 3 S1) (nth 3 S2)))))
  118.  
  119. ; Group by Y
  120. (setq NumItems (length TextEntList))
  121. (setq NumRows (1+ (fix (+ 0.5 (/ (- Ymax Ymin) Yspace)))))
  122.  
  123. (setq RowList nil)
  124. (repeat NumRows
  125.         (setq RowList (cons '() RowList))       ; build list with emply list elements for each row
  126. ) ; close repeat
  127.  
  128. (setq CNT 0)
  129. (repeat (length TextEntList)
  130.         (setq MyItem (nth CNT TextEntList))
  131.         (setq Y (nth 3 MyItem))
  132.  
  133.         (setq Index (fix (+ 0.5 (/ (- Y Ymin) Yspace))))                                ; get index
  134.         (setq RowList (replace1 RowList Index (cons MyItem (nth Index RowList))))       ; update RowList to include current item
  135.  
  136.         (setq CNT (1+ CNT))
  137. ) ; close repeat
  138. (setq RowList (reverse RowList))        ; reverse to place row with largest Y first
  139.  
  140.  
  141. ; Sort each sublist in RowList by X
  142. (setq CNT 0)
  143. (repeat (length RowList)
  144.         (setq MyItem (nth CNT RowList))
  145.         (setq MyItem (vl-sort MyItem '(lambda (S1 S2) (< (nth 2 S1) (nth 2 S2)))))      ; sort by X
  146.  
  147.         (setq RowList (replace1 RowList CNT MyItem))                                    ; update RowList with sorted values
  148.  
  149.         (setq CNT (1+ CNT))
  150. ) ; close repeat
  151.        
  152. ; Process output
  153. (setq OutList nil)
  154.         ((eq RetCode 0)
  155.           (progn
  156.                 ; Return simple nested list of text values
  157.                 (setq CNT 0)
  158.                 (repeat (length RowList)
  159.                         (setq MyItem (nth CNT RowList))
  160.  
  161.                         (setq OutList1 nil)
  162.                         (setq CNT1 0)
  163.                         (repeat (length MyItem)
  164.                                 (setq MyItem1 (nth CNT1 MyItem))
  165.  
  166.                                 (setq OutList1 (cons (nth 1 MyItem1) OutList1))
  167.                                 (setq CNT1 (1+ CNT1))
  168.                         ) ; close repeat               
  169.  
  170.                         (setq OutList (cons (reverse OutList1) OutList))
  171.  
  172.                         (setq CNT (1+ CNT))
  173.                 ) ; close repeat
  174.                 (setq OutList (reverse OutList))
  175.           )
  176.         )
  177.         ((eq RetCode 1)
  178.                 (setq OutList RowList)  ; more complex list
  179.         )
  180. ) ; close cond 
  181.  
  182. OutList
  183. )
  184.  
  185.  
  186. (defun Replace1 (MyLIST POS NEWITEM / K CNT NEWLIST)
  187. ; Replace one item in a list with a new item
  188. ; KJM - 1989?, Misc mods - KJM - Aug 2005
  189. ; Input:
  190. ;       MyList - a list
  191. ;       POS - (integer) list position
  192. ;       NewItem - new item to be inserted into list, replacing old item
  193. ; Returns:
  194. ;       List with item replaced
  195.  
  196.         (setq K 1)
  197.         (setq CNT 0)
  198.         (setq NEWLIST nil)
  199.         (while K
  200.                 (if (= POS CNT)
  201.                   (progn
  202.                         (setq NEWLIST (cons NEWITEM NEWLIST))
  203.                         (setq K nil)
  204.                   )
  205.                   (setq NEWLIST (cons (nth CNT MyLIST) NEWLIST))
  206.                 )
  207.                 (setq CNT (1+ CNT))
  208.         )      
  209.         (repeat (- (length MyList) CNT)
  210.                 (setq NEWLIST (cons (nth CNT MyLIST) NEWLIST))
  211.                 (setq CNT (1+ CNT))
  212.         )
  213.         (setq NEWLIST (reverse NEWLIST))
  214.         NEWLIST
  215. )
  216.  


Output:
(S1 1350 Type C 95.861 94.57 1.066 577058.125 135718.604)
(S2 1350 Type C 95.741 94.47 1.046 577058.180 135706.489)
(S3 1350 Type C 95.544 94.22 1.099 577055.753 135686.910)
(S4 1350 Type C 95.358 94.02 1.113 577058.152 135669.421)
(S5 1350 Type C 95.209 93.925 1.059 577052.074 135656.460)
(S6 1350 Type C 97.424 96.29 0.909 577003.660 135702.212)
(S7 1350 Type C 96.260 95.05 0.985 577009.494 135671.766)
(S8 1350 Type C 95.372 93.97 1.177 577026.597 135656.388)

BIGAL

  • Swamp Rat
  • Posts: 1037
  • 40 + years of using Autocad
Re: [challenge ] A36 create a list of text lines table
« Reply #4 on: March 22, 2022, 11:05:13 PM »
Hi Johnk I went back and maybe did not explain well enough,I also went back through the challenges, re checked and Challenge A08 is very close but only has a single item list (a a b b b c) etc need ((a b c)(a d c) (a x f) the key to match is the car for me. mapcars are not something I am good at, hence request. I find trying to get the (car (car for testing falls over for me, I have set the Y as first value for simple test. I know I could write a lengthy way to compare nth x to nth y and have done so in past.

Please feel free to move to lisp section if you think so

Sorted on Y then X,  for readability would be nice to use car or cadr or caddr as key, then would be (X Y Text) oh yeah need sublist to be caddr value in this case. (als lst 1 3)

Code: [Select]
(setq lst '((99707.6544666654 490598.071208542 "Headwall 6")
(99707.6544666654 490604.373959542 "---")
(99707.6544666654 490610.589819542 "HEADWALL")
(99707.6544666654 490616.305679542 "6.40")
(99707.6544666654 490621.305679542 "4.92")
(99707.6544666654 490627.305679542 "0.58")
(99707.6544666654 490635.805679542 "490261.360")
(99707.6544666654 490645.805679542 "99414.081")
(99709.3211336654 490598.071208542 "Headwall 5")
(99709.3211336654 490604.373959542 "---")
(99709.3211336654 490610.589819542 "HEADWALL")
(99709.3211336654 490616.305679542 "6.40")
(99709.3211336654 490621.305679542 "4.945")
(99709.3211336654 490627.305679542 "0.555")
(99709.3211336654 490635.805679542 "490273.723")
(99709.3211336654 490645.805679542 "99421.043")
(99710.9877996654 490598.071208542 "Headwall 4")
(99710.9877996654 490604.373959542 "---")
(99710.9877996654 490610.589819542 "HEADWALL")
(99710.9877996654 490616.305679542 "6.40")
(99710.9877996654 490621.305679542 "4.965")
(99710.9877996654 490627.305679542 "0.535")
(99710.9877996654 490635.805679542 "490289.357")
(99710.9877996654 490645.805679542 "99424.165")
(99712.6544666654 490598.071208542 "Headwall 3")
(99712.6544666654 490604.373959542 "---")
(99712.6544666654 490610.589819542 "HEADWALL")
(99712.6544666654 490616.305679542 "6.40")
(99712.6544666654 490621.305679542 "4.985")
(99712.6544666654 490627.305679542 "0.515")
(99712.6544666654 490635.805679542 "490304.472")
(99712.6544666654 490645.805679542 "99434.481")
(99714.3211336654 490598.071208542 "Headwall 2")
(99714.3211336654 490604.373959542 "---")
(99714.3211336654 490610.589819542 "HEADWALL")
(99714.3211336654 490616.305679542 "6.40")
(99714.3211336654 490621.305679542 "5.06")
(99714.3211336654 490627.305679542 "0.44")
(99714.3211336654 490635.805679542 "490331.290")
(99714.3211336654 490645.805679542 "99496.421")
(99715.9877996654 490598.071208542 "Headwall 1")
(99715.9877996654 490604.373959542 "---")
(99715.9877996654 490610.589819542 "HEADWALL")
(99715.9877996654 490616.305679542 "6.40")
(99715.9877996654 490621.305679542 "4.99")
(99715.9877996654 490627.305679542 "0.51")
(99715.9877996654 490635.805679542 "490307.461")
(99715.9877996654 490645.805679542 "99456.40")
(99717.6544666654 490598.071208542 "HWMH20.2")
(99717.6544666654 490604.373959542 "1350")
(99717.6544666654 490610.589819542 "Type C")
(99717.6544666654 490616.305679542 "6.314")
(99717.6544666654 490621.305679542 "4.63")
(99717.6544666654 490627.305679542 "1.459")
(99717.6544666654 490635.805679542 "489873.838")
(99717.6544666654 490645.805679542 "99575.409")
(99719.3211336654 490598.071208542 "HWMH20.1")
(99719.3211336654 490604.373959542 "1350")
(99719.3211336654 490610.589819542 "Type C")
(99719.3211336654 490616.305679542 "6.428")
(99719.3211336654 490621.305679542 "4.71")
(99719.3211336654 490627.305679542 "1.493")
(99719.3211336654 490635.805679542 "489870.211")
(99719.3211336654 490645.805679542 "99563.764")
))

Thanks also to Kirby end result is what I want, I believe can be done with way less code using mapcar.
« Last Edit: March 22, 2022, 11:36:32 PM by BIGAL »
A man who never made a mistake never made anything

BIGAL

  • Swamp Rat
  • Posts: 1037
  • 40 + years of using Autocad
Re: [challenge ] A36 create a list of text lines table
« Reply #5 on: March 26, 2022, 10:41:26 PM »
This is what I ended up using but I am sure a mapcar type of answer would be better. Its coded for the problem but I think it could be more a generic defun.

(als lst 1 3) key is 1st item in list but save 3rd item in a grouped list.

Code: [Select]

(setq val1 (nth 0 lst))
(setq lst2 '() lst3 '())
(setq lst2 (cons (caddr val1) lst2))
(setq x 0)
(repeat (- (length lst) 1)
(setq val2 (nth (setq x (1+ x)) lst))
(if (equal (car val1) (car val2) 0.0002)
(setq lst2 (cons (caddr val2) lst2) val1 val2)
(setq lst3 (cons (reverse lst2) lst3) lst2 '() lst2 (cons (caddr val2) lst2) val1 val2)
)
)
(setq lst2 (cons (caddr val2) lst2))
(setq lst3 (cons (reverse lst2) lst3))

(("HWMH20.1" "1350" "Type C" "6.428" "4.71" "1.493" "489870.211" "99563.764" "99563.764")
("HWMH20.2" "1350" "Type C" "6.314" "4.63" "1.459" "489873.838" "99575.409")
("Headwall 1" "---" "HEADWALL" "6.40" "4.99" "0.51" "490307.461" "99456.40")
("Headwall 2" "---" "HEADWALL" "6.40" "5.06" "0.44" "490331.290" "99496.421")
("Headwall 3" "---" "HEADWALL" "6.40" "4.985" "0.515" "490304.472" "99434.481")
("Headwall 4" "---" "HEADWALL" "6.40" "4.965" "0.535" "490289.357" "99424.165")
("Headwall 5" "---" "HEADWALL" "6.40" "4.945" "0.555" "490273.723" "99421.043")
("Headwall 6" "---" "HEADWALL" "6.40" "4.92" "0.58" "490261.360" "99414.081"))
« Last Edit: March 27, 2022, 07:28:30 PM by BIGAL »
A man who never made a mistake never made anything