+ Reply to Thread
Results 1 to 8 of 8
  1. #1
    Full Member Luís Augusto's Avatar
    Discipline
    Electrical
    Luís Augusto's Discipline Details
    Occupation
    Designer / Planner
    Discipline
    Electrical
    Details
    Manufacture of electrical harnesses
    Using
    AutoCAD 2010
    Join Date
    Apr 2012
    Location
    Botucatu, SP, Brazil
    Posts
    80

    Default Sort list (Letters and Numbers)

    Registered forum members do not see this ad.

    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: <" 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)

  2. #2
    Forum Deity pBe's Avatar
    Computer Details
    pBe's Computer Details
    Operating System:
    Windows 8.1
    Discipline
    Landscape
    Using
    AutoCAD 2015
    Join Date
    Apr 2010
    Posts
    2,951

    Default

    maybe....
    Code:
    .....
    (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
    		 )
    	  )
    .....

  3. #3
    Full Member Luís Augusto's Avatar
    Discipline
    Electrical
    Luís Augusto's Discipline Details
    Occupation
    Designer / Planner
    Discipline
    Electrical
    Details
    Manufacture of electrical harnesses
    Using
    AutoCAD 2010
    Join Date
    Apr 2012
    Location
    Botucatu, SP, Brazil
    Posts
    80

    Default

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

  4. #4
    Forum Deity pBe's Avatar
    Computer Details
    pBe's Computer Details
    Operating System:
    Windows 8.1
    Discipline
    Landscape
    Using
    AutoCAD 2015
    Join Date
    Apr 2010
    Posts
    2,951

    Default

    Quote Originally Posted by Luís Augusto View Post
    Perfect pBe!
    ...Thank you very much.
    Cool, glad you had it "sorted" [<--- pun]

  5. #5
    Full Member Luís Augusto's Avatar
    Discipline
    Electrical
    Luís Augusto's Discipline Details
    Occupation
    Designer / Planner
    Discipline
    Electrical
    Details
    Manufacture of electrical harnesses
    Using
    AutoCAD 2010
    Join Date
    Apr 2012
    Location
    Botucatu, SP, Brazil
    Posts
    80

    Default

    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
    Code:
    (setq attdata (vl-sort attdata '(lambda (x y)(< (cdr x)(cdr y)))))
    modified for
    Code:
    (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

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

  6. #6
    Forum Deity pBe's Avatar
    Computer Details
    pBe's Computer Details
    Operating System:
    Windows 8.1
    Discipline
    Landscape
    Using
    AutoCAD 2015
    Join Date
    Apr 2010
    Posts
    2,951

    Default

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

    [see attached file]
    Attached Files
    Last edited by pBe; 5th Mar 2014 at 06:36 am.

  7. #7
    Full Member Luís Augusto's Avatar
    Discipline
    Electrical
    Luís Augusto's Discipline Details
    Occupation
    Designer / Planner
    Discipline
    Electrical
    Details
    Manufacture of electrical harnesses
    Using
    AutoCAD 2010
    Join Date
    Apr 2012
    Location
    Botucatu, SP, Brazil
    Posts
    80

    Default

    Quote Originally Posted by pBe View Post
    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.

    Code:
    (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.
    Last edited by Luís Augusto; 5th Mar 2014 at 11:46 pm. Reason: Refresh

  8. #8
    Full Member Luís Augusto's Avatar
    Discipline
    Electrical
    Luís Augusto's Discipline Details
    Occupation
    Designer / Planner
    Discipline
    Electrical
    Details
    Manufacture of electrical harnesses
    Using
    AutoCAD 2010
    Join Date
    Apr 2012
    Location
    Botucatu, SP, Brazil
    Posts
    80

    Default

    Registered forum members do not see this ad.

    Update response.
    Post No. 7 was edited.

Similar Threads

  1. filter/separate the letters/numbers
    By teknomatika in forum AutoLISP, Visual LISP & DCL
    Replies: 12
    Last Post: 17th Jun 2013, 11:57 am
  2. incrementing numbers and letters
    By JPlanera in forum AutoLISP, Visual LISP & DCL
    Replies: 4
    Last Post: 12th Jul 2012, 04:51 pm
  3. Replies: 3
    Last Post: 29th Dec 2011, 03:09 pm
  4. Automatically add letters/numbers after text
    By how do i do this? in forum AutoCAD General
    Replies: 2
    Last Post: 29th Jun 2011, 08:53 am
  5. filtering layers (containing numbers) and to ignoring letters in layer names
    By Croftyno1 in forum AutoLISP, Visual LISP & DCL
    Replies: 4
    Last Post: 16th Jun 2011, 10:28 am

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts