Sort list (Letters and Numbers
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: : "))) (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") ; 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)) ) ;(setq attdata (reverse attdata)) ))(setq attdata (vl-sort attdata '(lambda (x y)(< (cdr x)(cdr y)))))(setq attdata (mapcar '(lambda (a) (list (vl-string-subst "" "PIN_" (car a)) (cdr a) ) ) attdata ))..... Perfect pBe!
I did not understand the explanation in the documentation of Autodesk.
I will read it again.
Thank you very much.
Cool, glad you had it "sorted" [ 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)(< (car x)(car 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) Question for you, Is this routine block name specific?
"Build mode B - Numerical" and "Build mode B - Letters"?
clist.LSP
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_#*")(setqattdata (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. Update response.
Post No. 7 was edited.
页:
[1]