Jump to content

Sort list (Letters and Numbers)


Luís Augusto

Recommended Posts

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)

Link to comment
Share on other sites

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
	 )
  )
.....

Link to comment
Share on other sites

  • 1 month later...

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. :unsure:

 

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)

Link to comment
Share on other sites

Question for you, Is this routine block name specific?

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

 

[see attached file]

clist.LSP

Edited by pBe
Link to comment
Share on other sites

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. :thumbsup:

 

(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 by Luís Augusto
Refresh
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...