Sort list (Letters and Numbers

Luís Augusto · 发表于 2022-7-5 23:26:43

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

[code];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") ;

pBe · 发表于 2022-7-5 23:35:31

maybe....

copy

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

Luís Augusto · 发表于 2022-7-5 23:49:50

Perfect pBe!
I did not understand the explanation in the documentation of Autodesk.
I will read it again.
Thank you very much.

pBe · 发表于 2022-7-5 23:53:37

Cool, glad you had it "sorted" [

Luís Augusto · 发表于 2022-7-6 00:07:26

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

copy

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

modified for

copy

(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

copy

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

pBe · 发表于 2022-7-6 00:14:56

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

[see attached file]
clist.LSP

Luís Augusto · 发表于 2022-7-6 00:21:10

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.

copy

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

Luís Augusto · 发表于 2022-7-6 00:30:29

Update response.
Post No. 7 was edited.

[编程交流] Sort list (Letters and Numbers

发表回复

精选推荐