Sort list (Letters and Numbers)

February 3, 2014

Hello everybody.

I need help to sort lists in a code.

Use a program created by the great Fixo to create tables containing some attributes. I found that, depending on how the block is built, the end result will be undesired.

I took the liberty of attaching the file exemplifying the case.

Any help will be appreciated.

Luís Augusto.

Sort list.dwg

;Oleg Fateev
;16th Jan 2014 06:18 pm

(defun C:CLIST

       (/
	acapp
	acsp
	adoc
	atable
	attdata
	attitem
	atts
	blkname
	blkobj
	col
	en
	headers
	pt
	row
	sset
	title
       )
	   
 (txtNotExists)
 (TablExists)
   
 (or adoc
     (setq adoc
     (vla-get-activedocument (setq acapp (vlax-get-acad-object)))
     )
 )
 (or acsp
     (setq acsp (vla-get-block (vla-get-activelayout adoc)))
 )
 (if (setq sset (ssget	"_:S:E:L"
		(list (cons 0 "INSERT")
		      (cons 66 1)
		      (cons 410 (getvar "ctab"))
		)
	 )
     )
   (progn
     (setq en (ssname sset 0))
     (setq blkobj  (vlax-ename->vla-object en)
    blkname (vla-get-effectivename blkobj)
     )
     (if (/= blkname "*");any other block different "*"
(progn
  (setq atts (vlax-invoke blkobj 'getattributes))
  (foreach attobj atts
    (if	(wcmatch (vla-get-tagstring attobj) "PIN_*");change "PIN_#*" use letters also
      (progn
	(setq attitem (cons (vla-get-tagstring attobj)
			    (vla-get-textstring attobj)
		      )
	)
	(setq attdata (cons attitem attdata))
      )
      (setq attdata (reverse attdata))
    )
  )
  (setq	attdata
	 (mapcar '(lambda (a)
		    (list (vl-string-subst "" "PIN_" (car a))
			  (cdr a)
		    )
		  )
		 attdata
	 )
  )
  (if (setq pt (getpoint "\nSpecify table location:"))
    (progn
      (setvar 'ctablestyle "TB_CONECTORS")
      (setq atable
	     (vla-addtable
	       acsp
	       (vlax-3d-point pt)
	       (+ 2 (length attdata))
	       2
	       (/ (getvar 'dimtxt) 2)
	       (* (getvar 'dimtxt) 16)
	     )
      )
      (vla-put-regeneratetablesuppressed atable :vlax-true)
      (setq col 0)
      (foreach wid (list 4.5 30.5)
	(vla-setcolumnwidth atable col wid)
	(setq col (1+ col))
      )
      (vla-put-horzcellmargin atable 0.3)
      (vla-put-vertcellmargin atable 0.3)
      (vla-setTextheight atable 1 2.0)
      (vla-setTextheight atable 2 1.4)
      (vla-setTextheight atable 4 1.4)	
      (setq title blkname)
				;(setq title (getstring (strcat "\nTable title: <" blkname ">: ")))
      (if (eq "" title)
	(setq title blkname)
      )
      (vla-setText atable 0 0 title)
      (vla-setcelltextheight atable 0 0 2.0)
      (vla-SetCellAlignment atable 0 0 acMiddleCenter)
      (setq headers
	     (list "Pin" "Circuit / Color / Section / Mark")
      )
      (setq row	1
	    col	0
      )
      (repeat (length headers)
	(vla-SetCellAlignment atable row col acMiddleCenter)
	(vla-setcelltextheight atable row col 1.4)
	(vla-setText atable row col (car headers))
	(setq headers (cdr headers))
	(setq col (1+ col))
      )
      (setq row 2)
      (foreach record attdata
	(setq col 0)
	(foreach item record
	  (vla-setText atable row col item)
	  (if (= 0 col)
	    (vla-SetCellAlignment atable row col acMiddleCenter)
	    (vla-SetCellAlignment atable row col acMiddleLeft)
	  )
	  (vla-setcelltextheight atable row col 1.4)
	  (setq col (1+ col))
	)
	(setq row (1+ row))
      )
      (vla-put-regeneratetablesuppressed atable :vlax-false)
      (vla-put-height
	atable
	(+ (* (vla-get-rows atable) 2.2) 4.1)
      )
      (vla-update atable)
    )
  )
)
     )
   )
 )
 (princ)
)

(defun txtNotExists ()
 (if (not (tblsearch "style" "ARIAL_2.0"))
   (progn

     (entmake
(list
  '(0 . "STYLE") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbTextStyleTableRecord")
  '(2 . "ARIAL_2.0")		;<- Your style name here
  '(70 . 0) '(40 . 2.0)	'(41 . 1.0) '(50 . 0.0)	'(71 . 0) '(42 . 0.09375)
  '(3 . "Arial.ttf") '(4 . ""))
     )
     (princ)
   )

 )
)

(defun TablExists ()
(vl-load-com)
(setq stylename "TB_CONECTORS")
(setq actdoc (vla-get-activedocument (vlax-get-acad-object)))
(setq dict (vla-get-dictionaries actdoc))
(setq tabcol (vla-item dict "acad_tablestyle"))
(if 
     (vl-catch-all-error-p
           (setq tabsty (vl-catch-all-apply
                              'vla-item
                              (list tabcol stylename))))
     (progn
    (vl-load-com)
    (MakeTableStyle)
     )
)
(princ)
)

(vl-load-com)
(defun MakeTableStyle()
  
;;http://hyperpics.blogs.com/beyond_the_ui/2012/07/creating-a-table-style-with-autolisp-and-the-activex-api.html
;;By Lee Ambrosius

;; Get the AutoCAD application and current document
   (setq acad (vlax-get-acad-object))
   (setq doc (vla-get-ActiveDocument acad))

       ;; Get the Dictionaries collection and the TableStyle dictionary
   (setq dicts (vla-get-Dictionaries doc))
   (setq dictObj (vla-Item dicts "acad_tablestyle"))
   
       ;; Create a custom table style
   (setq key "TB_CONECTORS" class "AcDbTableStyle") 
   (setq custObj (vla-AddObject dictObj key class))

       ;; Set the name and description for the style
   (vla-put-Name custObj "TB_CONECTORS")
   (vla-put-Description custObj "Tabela de conectores")

       ;; Sets the bit flag value for the style
   (vla-put-BitFlags custObj 1)

       ;; Sets the direction of the table, top to bottom or bottom to top
   (vla-put-FlowDirection custObj acTableTopToBottom)

       ;; Sets the supression of the table header
   (vla-put-HeaderSuppressed custObj :vlax-false)

       ;; Sets the horizontal margin for the table cells
   (vla-put-HorzCellMargin custObj 0.3)

       ;; Sets the supression of the table title
   (vla-put-TitleSuppressed custObj :vlax-false)

       ;; Sets the vertical margin for the table cells
   (vla-put-VertCellMargin custObj 0.3)

       ;; Set the alignment for the Data, Header, and Title rows
   (vla-SetAlignment custObj (+ acDataRow acTitleRow) acMiddleLeft)
   (vla-SetAlignment custObj acHeaderRow acMiddleCenter)

   ;; Set the text height for the Title, Header and Data rows
   (vla-SetTextHeight custObj acTitleRow 1.5)
   (vla-SetTextHeight custObj (+ acDataRow acHeaderRow) 1.0)

       ;; Set the text height and style for the Title row
   (vla-SetTextStyle custObj (+ acDataRow acHeaderRow acTitleRow) "ARIAL_2.0")

 (princ)
)

(prompt "\n\t---\tStart command with CLIST\t---\n")
(prin1)
(or (vl-load-com))
(princ)

February 3, 2014

maybe....

.....
(progn
  (setq atts (vlax-invoke blkobj 'getattributes))
(foreach attobj atts
    (if	(wcmatch (vla-get-tagstring attobj) "PIN_*");change "PIN_#*" use letters also
      (progn
	(setq attitem (cons (vla-get-tagstring attobj)
			    (vla-get-textstring attobj)
		      )
	)
	(setq attdata (cons attitem attdata))
      )
      [color="blue"][b];(setq attdata (reverse attdata))[/b][/color]
      
    )
  )
[b][color="blue"](setq attdata (vl-sort attdata '(lambda (x y)(< (cdr x)(cdr y)))))[/color][/b]
(setq	attdata
	 (mapcar '(lambda (a)
		    (list (vl-string-subst "" "PIN_" (car a))
			  (cdr a)
		    )
		  )
		 attdata
	 )
  )
.....

February 3, 2014

Perfect pBe!

I did not understand the explanation in the documentation of Autodesk.

I will read it again.

Thank you very much.

February 4, 2014

Perfect pBe!
...Thank you very much.

Cool, glad you had it "sorted" [

March 4, 2014

Hello everybody.

pBe, I had to make a small change to the code you provided me.

On the part of the code where it says

(setq attdata (vl-sort attdata '(lambda (x y)(< (cdr x)(cdr y)))))

modified for

(setq attdata (vl-sort attdata '(lambda (x y)(< ([color="red"]car[/color] x)([color="red"]car[/color] y)))))

I had not noticed the problem earlier because the values were within the attribute, coincided with the tag values.

With the changes I made, the program began to sort by tag name. All tags whose value are letters, sorting is happening as expected, however, when ordering numbers, I get an unwanted result.

Expected to get 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16.

However I get the following value, 1,10,11,12,13,14,15,16,2,3,4,5,6,7,8,9.

Could someone help me understand and fix this problem?

Sort list2.dwg

;;--------------------------------------------------------------------------------------;;
;;--------------------------------------------------------------------------------------;;
;;   Create by Oleg Fateev (fixo)                                                       ;;
;;   http://www.cadtutor.net/forum/showthread.php?83991-Populate-Table                  ;;
;;                                                                                      ;;
;;   Modified by pBe                                                                    ;;
;;   http://www.cadtutor.net/forum/showthread.php?84356-Sort-list-(Letters-and-Numbers) ;;
;;                                                                                      ;;
;;   Modified by Luís Augusto                                                           ;;
;;   Table and Text Style                                                               ;;
;;--------------------------------------------------------------------------------------;;
;;--------------------------------------------------------------------------------------;;

(defun C:CLIST

       (/	acapp	acsp	adoc	atable	attdata	attitem
	atts	blkname	blkobj	col	en	headers	pt
	row	sset	title
       )

 (txtNotExists)
 (TablExists)

 (or adoc
     (setq adoc
     (vla-get-activedocument (setq acapp (vlax-get-acad-object)))
     )
 )
 (or acsp
     (setq acsp (vla-get-block (vla-get-activelayout adoc)))
 )
 (if (setq sset (ssget	"_:S:E:L"
		(list (cons 0 "INSERT")
		      (cons 66 1)
		      (cons 410 (getvar "ctab"))
		)
	 )
     )
   (progn
     (setq en (ssname sset 0))
     (setq blkobj  (vlax-ename->vla-object en)
    blkname (vla-get-effectivename blkobj)
     )
     (if (/= blkname "*");any other block different "*"
(progn
  (setq atts (vlax-invoke blkobj 'getattributes))
  (foreach attobj atts
    (if	(wcmatch (vla-get-tagstring attobj) "PIN_*");change "PIN_#*" use letters also
      (progn
	(setq attitem (cons (vla-get-tagstring attobj)
			    (vla-get-textstring attobj)
		      )
	)
	(setq attdata (cons attitem attdata)) ;(setq attdata (reverse attdata))
      )
				

    )
  )
  (setq	attdata	(vl-sort attdata
			 '(lambda (x y) (< (car x) (car y))) ;Modified to car. Sorted by tag PIN.
		)
  )				
  (setq	attdata
	 (mapcar '(lambda (a)
		    (list (vl-string-subst "" "PIN_" (car a))
			  (cdr a)
		    )
		  )
		 attdata
	 )
  )
  (if (setq pt (getpoint "\nSpecify table location:"))
    (progn
      (setvar 'ctablestyle "TB_CONECTORS")
      (setq atable
	     (vla-addtable
	       acsp
	       (vlax-3d-point pt)
	       (+ 2 (length attdata))
	       2
	       (/ (getvar 'dimtxt) 2)
	       (* (getvar 'dimtxt) 16)
	     )
      )
      (vla-put-regeneratetablesuppressed atable :vlax-true)
      (setq col 0)
      (foreach wid (list 4.5 30.5)
	(vla-setcolumnwidth atable col wid)
	(setq col (1+ col))
      )
      (vla-put-horzcellmargin atable 0.3)
      (vla-put-vertcellmargin atable 0.3)
      (vla-setTextheight atable 1 2.0)
      (vla-setTextheight atable 2 1.4)
      (vla-setTextheight atable 4 1.4)
      (setq title blkname)
      (if (eq "" title)
	(setq title blkname)
      )
      (vla-setText atable 0 0 title)
      (vla-setcelltextheight atable 0 0 2.0)
      (vla-SetCellAlignment atable 0 0 acMiddleCenter)
      (setq headers
	     (list "Pin" "Circuit / Color / Section / Mark")
      )
      (setq row	1
	    col	0
      )
      (repeat (length headers)
	(vla-SetCellAlignment atable row col acMiddleCenter)
	(vla-setcelltextheight atable row col 1.4)
	(vla-setText atable row col (car headers))
	(setq headers (cdr headers))
	(setq col (1+ col))
      )
      (setq row 2)
      (foreach record attdata
	(setq col 0)
	(foreach item record
	  (vla-setText atable row col item)
	  (if (= 0 col)
	    (vla-SetCellAlignment atable row col acMiddleCenter)
	    (vla-SetCellAlignment atable row col acMiddleLeft)
	  )
	  (vla-setcelltextheight atable row col 1.4)
	  (setq col (1+ col))
	)
	(setq row (1+ row))
      )
      (vla-put-regeneratetablesuppressed atable :vlax-false)
      (vla-put-height
	atable
	(+ (* (vla-get-rows atable) 2.2) 4.1)
      )
      (vla-update atable)
    )
  )
)
     )
   )
 )
 (princ)
)

(defun txtNotExists ()
 (if (not (tblsearch "style" "ARIAL_2.0"))
   (progn

     (entmake
(list
  '(0 . "STYLE")
  '(100 . "AcDbSymbolTableRecord")
  '(100
    .
    "AcDbTextStyleTableRecord"
   )
  '(2 . "ARIAL_2.0")
  '(70 . 0)
  '(40 . 2.0)
  '(41 . 1.0)
  '(50 . 0.0)
  '(71 . 0)
  '(42 . 0.09375)
  '(3 . "Arial.ttf")
  '(4 . "")
)
     )
     (princ)
   )

 )
)

(defun TablExists ()
 (vl-load-com)
 (setq stylename "TB_CONECTORS")
 (setq actdoc (vla-get-activedocument (vlax-get-acad-object)))
 (setq dict (vla-get-dictionaries actdoc))
 (setq tabcol (vla-item dict "acad_tablestyle"))
 (if
   (vl-catch-all-error-p
     (setq tabsty (vl-catch-all-apply
	     'vla-item
	     (list tabcol stylename)
	   )
     )
   )
    (progn
      (vl-load-com)
      (MakeTableStyle)
    )
 )
 (princ)
)

(vl-load-com)
(defun MakeTableStyle ()

 ;;http://hyperpics.blogs.com/beyond_the_ui/2012/07/creating-a-table-style-with-autolisp-and-the-activex-api.html
 ;;By Lee Ambrosius

 ;; Get the AutoCAD application and current document
 ;; Obter o aplicativo AutoCAD e documento atual
 (setq acad (vlax-get-acad-object))
 (setq doc (vla-get-ActiveDocument acad))

 ;; Get the Dictionaries collection and the TableStyle dictionary
 ;; Obter a coleção de dicionários e o dicionário TableStyle
 (setq dicts (vla-get-Dictionaries doc))
 (setq dictObj (vla-Item dicts "acad_tablestyle"))

 ;; Create a custom table style
 ;; Criar um estilo de tabela personalizado
 (setq	key   "TB_CONECTORS"
class "AcDbTableStyle"
 )					;(setq key "MyTableStyle" class "AcDbTableStyle")
 (setq custObj (vla-AddObject dictObj key class))

 ;; Set the name and description for the style
 ;; Defina o nome e uma descrição para o estilo

 (vla-put-Name custObj "TB_CONECTORS")
 (vla-put-Description custObj "Tabela de conectores")

 ;; Sets the bit flag value for the style
 ;; Define o valor sinalizador de bits para o estilo
 (vla-put-BitFlags custObj 1)

 ;; Sets the direction of the table, top to bottom or bottom to top
 ;; Define a direção da tabela, de cima para baixo ou de baixo para cima
 (vla-put-FlowDirection custObj acTableTopToBottom)

 ;; Sets the supression of the table header
 ;; Define a supressão do cabeçalho da tabela
 (vla-put-HeaderSuppressed custObj :vlax-false)

 ;; Sets the horizontal margin for the table cells
 ;; Define a margem horizontal para as células da tabela
 (vla-put-HorzCellMargin custObj 0.3)

 ;; Sets the supression of the table title
 ;; Define a supressão do título da tabela
 (vla-put-TitleSuppressed custObj :vlax-false)

 ;; Sets the vertical margin for the table cells
 ;; Define a margem vertical para as células da tabela
 (vla-put-VertCellMargin custObj 0.3)

 ;; Set the alignment for the Data, Header, and Title rows
 ;; Definir o alinhamento para as linhas de dados, cabeçalho e título	
 (vla-SetAlignment
   custObj
   (+ acDataRow acTitleRow)
   acMiddleLeft
 )
 (vla-SetAlignment custObj acHeaderRow acMiddleCenter)

 ;; Set the text height for the Title, Header and Data rows
 ;; Ajuste a altura do texto para as linhas Título, Cabeçalho e Dados
 (vla-SetTextHeight custObj acTitleRow 1.5)
 (vla-SetTextHeight custObj (+ acDataRow acHeaderRow) 1.0)

 ;; Set the text height and style for the Title row
 ;; Ajuste a altura do texto e estilo para a linha de título
 (vla-SetTextStyle
   custObj
   (+ acDataRow acHeaderRow acTitleRow)
   "ARIAL_2.0"
 )

 (princ)
)

(prompt "\n\t---\tStart command with CLIST\t---\n")
(prin1)
(or (vl-load-com))
(princ)

March 5, 2014

Question for you, Is this routine block name specific?

"Build mode B - Numerical" and "Build mode B - Letters"?

[see attached file]

clist.LSP

Edited March 5, 2014 by pBe

March 5, 2014

Question for you, Is this routine block name specific?
"Build mode B - Numerical" and "Build mode B - Letters"?

This routine does not deal with specific names, the blocks are just one example.

pBe,

Many thanks for writing "_nopin" function, this solved the problem.

(if (wcmatch (car (car attdata)) "PIN_#*")
(setq
  attdata (vl-sort attdata
		   '(lambda (x y)
		      (< (_nopin (car x)) (_nopin (car y)))
		    )
	  )
)				
(setq attdata
       (vl-sort attdata '(lambda (x y) (< (car x) (car y))))
)
     )

clist.LSP

Best regards, Luís Augusto.

Edited March 5, 2014 by Luís Augusto
Refresh

March 8, 2014

Update response.

Post No. 7 was edited.

Sign In

Sort list (Letters and Numbers)

Recommended Posts

Luís Augusto

pBe

Luís Augusto

pBe

Luís Augusto

pBe

Luís Augusto

Luís Augusto

Join the conversation

Tutorials

Forums

Activity