Lisp that make selected text put in table arrangement
@Tolearnlisp wrote:
Is a LISP routine possible to make a selected text placed automatically in a table
(defun c:Tablethisthingy ( / _DXF _isValidSelection _filterThisLayer _firstColumnText
_SecondColumnText collectedData filteredLW i pl textinside )
(defun _DXF (el m ) (assoc m (entget el)))
(defun _isValidSelection (msg m / e)
(if (and
(setq e (car (entsel (strcat "\nSelect" msg "reference " m ))))
(eq (Cdr (assoc 0 (entget e))) m)
)
e
)
)
(if
(and
(setq _filterThisLayer (_isValidSelection " " "LWPOLYLINE"))
(setq _firstColumnText (_isValidSelection " First column " "TEXT"))
(setq _SecondColumnText (_isValidSelection " Second column " "TEXT"))
(setq filteredLW (ssget "_X" (list '(0 . "LWPOLYLINE")(cons 410 (Getvar 'ctab))
(_DXF _filterThisLayer 8))))
(setq basepoint (getpoint "\nPick point for Table:"))
)
(progn
(setq _firstColumnText (_DXF _firstColumnText 8))
(setq _SecondColumnText (_DXF _SecondColumnText 8))
(repeat (setq i (sslength filteredLW))
(setq pl (ssname filteredLW (setq i (1- i))))
(if
(and
(setq textinside (ssget "CP"
(mapcar 'cdr
(vl-remove-if-not
'(lambda (d) (= (car d) 10))
(entget pl)
)
)
(list '(0 . "TEXT")'(-4 . "<OR")
_firstColumnText _SecondColumnText '(-4 . "OR>")
)
)
)
(= (sslength textinside) 2)
)
(setq collectedData
(cons
(mapcar
'(lambda (n)
(mapcar
'(lambda (d)
(cdr
(_DXF (ssname textinside n)
d
)
)
)
'(8 1)
)
)
'(0 1)
)
collectedData
)
)
)
)
(if (and
(setq filtered
(mapcar '(lambda (l)
(mapcar '(lambda (f)(cadr (assoc l f))) collectedData))
(mapcar 'cdr (list _firstColumnText _SecondColumnText))
)
)
(setq collectedData
(vl-sort (mapcar 'list (Car filtered)(Cadr filtered))
'(lambda (a b)(< (cadr a)(cadr b))))
)
)
(progn
(setq SupportDrawingTable
(vlax-invoke (vlax-get (vla-get-ActiveLayout (vla-get-ActiveDocument
(vlax-get-acad-object))) 'Block)
'Addtable basepoint
2 2 0.1 0.8 )
)
(vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-true)
(mapcar '(lambda (y)
(vla-settext SupportDrawingTable 1 (car y) (cadr y))
(vla-setcelltextheight SupportDrawingTable 1 (car y) 0.08)
)
'((0 "Text 1")(1 "Text 2")))
(vla-SetRowHeight SupportDrawingTable 1 0.19)
(foreach col '((0 0.85)(1 0.85))
(vla-SetColumnWidth SupportDrawingTable (Car col)(cadr col))
)
(vla-InsertRowsAndInherit SupportDrawingTable 2 1 (setq i (length collectedData)))
(setq row 1)
(while (setq a (car collectedData))
(vla-settext SupportDrawingTable (setq row (1+ row)) 0 (car a))
(vla-settext SupportDrawingTable row 1 (cadr a))
(setq collectedData (cdr collectedData))
)
(vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-false)
(vla-DeleteRows SupportDrawingTable 0 1)
)
)
)
)
(princ)
)
@Sea-Haven wrote:
... If you read the posts again you will see that the OP only put boxes around the text to clarify in reality they do not exist..
Good catch!
You are right, I dd not read the posts. I do have an idea on how to approach this condition. I'll look into this later
🙂
@Tolearnlisp wrote:
thank you @pbejse,
I tried the program and run several trials, there are things that I've noticed like below:
...
... there are things that I've noticed, why is there two 1. 🙂
Here's what we're going to do:
- There would be no selection for LWPOLYLINE [ Not existing as per posts ]
- Now it would depend on your selection
- The order would always be LEFT to RIGHT or TOP to BOTTOM
- We will remove the ssget filter "_X"
The first two prompts will determine the order on the table. [ Horizontal or Vertical ]
Command: TABLETHISTEXTTHINGY
Select First column reference TEXT ( select the TEXT object that will be on the first column )
Select Second column reference TEXT ( select the TEXT object that will be on the second column )
Select objects ( select the TEXT objects that you want to be included on the table )
(defun c:TablethisTextThingy ( / _DXF _isValidSelection _firstColumnText _SecondColumnText
FCT_lay SCT_lay basepoint collectedData i pl SupportDrawingTable )
(defun _DXF (el m ) (cdr (assoc m (entget el))))
(defun _isValidSelection (msg m / e)
(if (and
(setq e (car (entsel (strcat "\nSelect" msg "reference " m ))))
(eq (Cdr (assoc 0 (entget e))) m)
)
(list e (_DXF e 8))
)
)
(if
(and
(setq _firstColumnText (_isValidSelection " First column " "TEXT"))
(setq _SecondColumnText (_isValidSelection " Second column " "TEXT"))
(setq filteredLW (ssget (list '(0 . "TEXT")'(-4 . "<OR")
(cons 8 (Strcat (Cadr _firstColumnText) "," (cadr _SecondColumnText)))
'(-4 . "OR>")
))
)
(setq basepoint (getpoint "\nPick point for Table:"))
)
(progn
(setq ppts (mapcar '(lambda (p) (_DXF (Car p) 10))
(list _firstColumnText _SecondColumnText)))
(setq dist_XY (mapcar 'abs (mapcar '- (Car ppts)(cadr ppts))))
(setq sym (if (< (car dist_XY)(cadr dist_XY))
(list < Caar)(list > cadar)))
(repeat (setq i (sslength filteredLW))
(setq pl (ssname filteredLW (setq i (1- i))))
(setq data (list (_DXF pl 8)(_DXF pl 10)(_DXF pl 1)))
(if (eq (Car data) (cadr _firstColumnText))
(setq FCT_lay (cons (Cdr data) FCT_lay))
(setq SCT_lay (cons (Cdr data) SCT_lay))
)
)
(if (and FCT_lay
SCT_lay
(= (length FCT_lay) (length SCT_lay))
(setq SortedData
(mapcar
'(lambda (l)
(mapcar
'cadr
(vl-sort
l
'(lambda (a b)
((Car sym) ((Cadr sym) a) ((Cadr sym) b))
)
)
)
)
(list FCT_lay SCT_lay)
)
)
(setq collectedData
(mapcar 'list
(Car SortedData)
(Cadr SortedData)
)
)
)
(progn
(setq SupportDrawingTable
(vlax-invoke (vlax-get (vla-get-ActiveLayout (vla-get-ActiveDocument
(vlax-get-acad-object))) 'Block)
'Addtable basepoint
2 2 0.1 0.8 )
)
(vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-true)
(mapcar '(lambda (y)
(vla-settext SupportDrawingTable 1 (car y) (cadr y))
(vla-setcelltextheight SupportDrawingTable 1 (car y) 0.08)
)
'((0 "Text 1")(1 "Text 2")))
(vla-SetRowHeight SupportDrawingTable 1 0.19)
(foreach col '((0 0.85)(1 0.85))
(vla-SetColumnWidth SupportDrawingTable (Car col)(cadr col))
)
(vla-InsertRowsAndInherit SupportDrawingTable 2 1 (setq i (length collectedData)))
(setq row 1)
(while (setq a (car collectedData))
(vla-settext SupportDrawingTable (setq row (1+ row)) 0 (car a))
(vla-settext SupportDrawingTable row 1 (cadr a))
(setq collectedData (cdr collectedData))
)
(vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-false)
(vla-DeleteRows SupportDrawingTable 0 1)
)
)
)
)
(princ)
)
Command: TABLETHISTEXTTHINGY
Select First column reference TEXT [ The layer of this selected TEXT will be the first column value ]
Select Second column reference TEXT [ The layer of this selected TEXT will be the second column value ]
Select objects: [ refer to image ]
Specify first corner: Specify opposite corner: 34 found
Pick point for Table:
(defun c:TablethisTextThingy ( / _DXF _isValidSelection _firstColumnText _SecondColumnText
FCT_lay SCT_lay basepoint collectedData i pl ppts
dist_XY sym data SupportDrawingTable row a)
(defun _DXF (el m ) (cdr (assoc m (entget el))))
(defun _isValidSelection (msg m / e)
(if (and
(setq e (car (entsel (strcat "\nSelect" msg "reference " m ))))
(eq (Cdr (assoc 0 (entget e))) m)
)
(list e (_DXF e 8))
)
)
(if
(and
(setq _firstColumnText (_isValidSelection " First column " "TEXT"))
(setq _SecondColumnText (_isValidSelection " Second column " "TEXT"))
(setq filteredLW (ssget (list '(0 . "TEXT")'(-4 . "<OR")
(cons 8 (Strcat (Cadr _firstColumnText) "," (cadr _SecondColumnText)))
'(-4 . "OR>")
))
)
(setq basepoint (getpoint "\nPick point for Table:"))
)
(progn
(setq ppts (mapcar '(lambda (p) (_DXF (Car p) 10))
(list _firstColumnText _SecondColumnText)))
(setq dist_XY (mapcar 'abs (mapcar '- (Car ppts)(cadr ppts))))
(setq sym (if (< (car dist_XY)(cadr dist_XY))
(list < Caar)(list > cadar)))
(repeat (setq i (sslength filteredLW))
(setq pl (ssname filteredLW (setq i (1- i))))
(setq data (list (_DXF pl 8)(_DXF pl 10)(_DXF pl 1)))
(if (eq (Car data) (cadr _firstColumnText))
(setq FCT_lay (cons (Cdr data) FCT_lay))
(setq SCT_lay (cons (Cdr data) SCT_lay))
)
)
(if (and FCT_lay
SCT_lay
(= (length FCT_lay) (length SCT_lay))
(setq SortedData
(mapcar
'(lambda (l)
(mapcar
'cadr
(vl-sort
l
'(lambda (a b)
((Car sym) ((Cadr sym) a) ((Cadr sym) b))
)
)
)
)
(list FCT_lay SCT_lay)
)
)
(setq collectedData
(mapcar 'list
(Car SortedData)
(Cadr SortedData)
)
)
)
(progn
(setq SupportDrawingTable
(vlax-invoke (vlax-get (vla-get-ActiveLayout (vla-get-ActiveDocument
(vlax-get-acad-object))) 'Block)
'Addtable basepoint
2 2 0.1 0.8 )
)
(vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-true)
(mapcar '(lambda (y)
(vla-settext SupportDrawingTable 1 (car y) (cadr y))
(vla-setcelltextheight SupportDrawingTable 1 (car y) 0.08)
)
'((0 "Text 1")(1 "Text 2")))
(vla-SetRowHeight SupportDrawingTable 1 0.19)
(foreach col '((0 0.85)(1 0.85))
(vla-SetColumnWidth SupportDrawingTable (Car col)(cadr col))
)
(vla-InsertRowsAndInherit SupportDrawingTable 2 1 (setq i (length collectedData)))
(setq row 1)
(while (setq a (car collectedData))
(vla-settext SupportDrawingTable (setq row (1+ row)) 0 (car a))
(vla-settext SupportDrawingTable row 1 (cadr a))
(setq collectedData (cdr collectedData))
)
(vla-put-regeneratetablesuppressed SupportDrawingTable :vlax-false)
(vla-DeleteRows SupportDrawingTable 0 1)
)
)
)
)
(princ)
)
That's weird, I knew i posted a revised code last night ( twice ) with a screencast and image, somehow it keeps disappearing. 
Oh well
@Tolearnlisp wrote:
Hi @pbejse ,
Thank you for the below code I appreciated the instruction you have provided.
Is it possible to make the text order depend on the direction of how you will select the texts instead of just Top to Bottom and Left to right only. Thank you in advance.
So you did see the post.
The selection order won't be a factor on this version, the program will compare the collected list with the two selected text and use that as the first row for the table.
Command: TABLETHISTEXTTHINGY
Select First column reference TEXT [ as the reference for the first column ]
Select Second column reference TEXT [ as the reference for the second column ]
Select objects: Specify opposite corner: 36 found [ Note that this should be an even number ]
Select objects: [ Enter to end selection ]
Pick point for Table:
As before:
HTH
