Luís Augusto Posted February 3, 2014 Posted 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.dwgFetching info... ;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) Quote
pBe Posted February 3, 2014 Posted 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 ) ) ..... Quote
Luís Augusto Posted February 3, 2014 Author Posted 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. Quote
pBe Posted February 4, 2014 Posted February 4, 2014 Luís Augusto said: Perfect pBe! ...Thank you very much. Cool, glad you had it "sorted" [ Quote
Luís Augusto Posted March 4, 2014 Author Posted 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.dwgFetching info... ;;--------------------------------------------------------------------------------------;; ;;--------------------------------------------------------------------------------------;; ;; 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) Quote
pBe Posted March 5, 2014 Posted March 5, 2014 (edited) Question for you, Is this routine block name specific? "Build mode B - Numerical" and "Build mode B - Letters"? [see attached file] clist.LSPFetching info... Edited March 5, 2014 by pBe Quote
Luís Augusto Posted March 5, 2014 Author Posted March 5, 2014 (edited) pBe said: 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.LSPFetching info... Best regards, Luís Augusto. Edited March 5, 2014 by Luís Augusto Refresh Quote
Luís Augusto Posted March 8, 2014 Author Posted March 8, 2014 Update response. Post No. 7 was edited. Quote
Recommended Posts
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.