Simple fix (LISP noob) Syntax problem

[Lee Mac]

From 2000 -> 2004 help and 2012 Autodesk exchange

 

A string containing the pattern to match against string. The pattern can contain the wild-card pattern-matching characters shown in the table Wild-card characters. You can use commas in a pattern to enter more than one pattern condition. Only the first 500 characters (approximately) of the string and pattern are compared; anything beyond that is ignored

Go figure -David

 

_$ (setq str "x")
"x"
_$ (repeat 2000 (setq str (strcat "a" str)))
"aaaaaaaaaaaa...aaaaaaaaaax"
_$ (strlen str)
2001
_$ (wcmatch str "*x") [i][color=green];; Testing the very last character![/color][/i]
T

 

Go figure indeed!

[David Bethel]

LOL

 

You gotta love Autodesk

[3dwannab]

Consider the following:

Correct - the developer documentation in AutoCAD is not complete.
Thanks Lee Mac. I don't have that many of those blocks so I'll survive with this 

[Lee Mac]

You're welcome 3dwannab

[3dwannab]

Hi all, as promised I've complied all my quick selection tools and posted here. Take out them as you see fit. Left to do is any annotative objects.

 

;;---------------------=={ Selection Commands }==-----------------------;;
;;  3DwannaB_Quick_Select_Commands.lsp                                           ;;
;;----------------------------------------------------------------------;;
;;  Author: 3DwannaB, 2015                                              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    03-06-2015                                      ;;
;;----------------------------------------------------------------------;;
;(setq ss1 (ssget "all" ))

; (defun c:QS_ANNO_OBJECTS (/ ss) ; TO FIX
 ; (if (setq ss (ssget '((0 . "ALL"))))
   ; (princ (strcat "\nNumber of found Text objects : < " (itoa (sslength ss)) " >" ))
   ; (princ "\n***  Nothing Selected  ***")
 ; )
 ; (sssetfirst nil ss)
 ; (princ)
; )

;; by Lee Mac: http://www.cadtutor.net/forum/showthread.php?92638-Simple-fix-%28LISP-noob%29-Syntax-problem&p=633955&viewfull=1#post633955
;;  Note that the above code will still not be compatible with annotative dynamic blocks, as these will require yet more checks.
(defun c:QS_BLOCKS_ANNOTATIVE ( / blk def lst sel )
   (while (setq def (tblnext "block" (not def)))
       (setq blk (cdr (assoc 2 def)))
       (cond
           (   (= 4 (logand 4 (cdr (assoc 70 def))))
               (setq lst (cons (cons 2 (LM:escapewildcards blk)) lst))
           )
           (   (/= 1
                   (cdr
                       (assoc 1070
                           (reverse
                               (cadr
                                   (assoc -3
                                       (entget
                                           (cdr
                                               (assoc 330
                                                   (entget
                                                       (tblobjname "block" blk)
                                                   )
                                               )
                                           )
                                          '("AcadAnnotative")
                                       )
                                   )
                               )
                           )
                       )
                   )
               )
               (setq lst (cons (cons 2 (LM:escapewildcards blk)) lst))
           )
       )
   )
   (if lst
       (if (setq sel (ssget (append '((0 . "INSERT") (-4 . "<NOT") (-4 . "<OR")) lst '((-4 . "OR>") (-4 . "NOT>")))))
           (princ (strcat "\nNumber of blocks: " (itoa (sslength sel))))
           (princ "\nNothing selected.")
       )
       (princ "\nNo valid blocks found in drawing.")
   )
   (sssetfirst nil sel)
   (princ)
)

;; Escape Wildcards  -  Lee Mac
;; Escapes wildcard special characters in a supplied string

(defun LM:escapewildcards ( str )
   (vl-list->string
       (apply 'append
           (mapcar
              '(lambda ( c )
                   (if (member c '(35 64 46 42 63 126 91 93 45 44))
                       (list 96 c)
                       (list c)
                   )
               )
               (vl-string->list str)
           )
       )
   )
)

(defun c:QS_LINES_POLYLINES_ARCS_CIRCLES (/ ss)
 (if (setq ss (ssget '((0 . "LINE,LWPOLYLINE,ARC,CIRCLE"))))
   (princ (strcat "\nNumber of found Lines, Polylines, Arcs, Circles : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_POLY_OPEN (/ ss)
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "=") (70 . 0))))
   (princ (strcat "\nNumber of found open Polylines : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_POLY_CLOSED (/ ss)
 (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "=") (70 . 1))))
   (princ (strcat "\nNumber of found closed Polylines : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_POLY_ALL (/ ss)
 (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
   (princ (strcat "\nNumber of found Polylines : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_HATCH_ALL (/ ss)
 (if (setq ss (ssget '((0 . "HATCH"))))
   (princ (strcat "\nNumber of found hatches : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_HATCH_ASSOC (/ ss)
 (if (setq ss (ssget '((0 . "HATCH") (-4 . "=") (71 . 1))))
   (princ (strcat "\nNumber of found associative hatches : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_HATCH_NON_ASSOC (/ ss)
 (if (setq ss (ssget '((0 . "HATCH") (-4 . "=") (71 . 0))))
   (princ (strcat "\nNumber of found non-associative hatches : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_TEXT_SINGLE (/ ss)
 (if (setq ss (ssget '((0 . "TEXT"))))
   (princ (strcat "\nNumber of found single line Text objects : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_TEXT_MULTILINE (/ ss)
 (if (setq ss (ssget '((0 . "MTEXT"))))
   (princ (strcat "\nNumber of found multi line Text objects : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_TEXT_ALL (/ ss)
 (if (setq ss (ssget '((0 . "MTEXT,TEXT"))))
   (princ (strcat "\nNumber of found Text objects : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_DIMS_ALL (/ ss)
 (if (setq ss (ssget '((0 . "DIMENSION,LEADER"))))
   (princ (strcat "\nNumber of found Dimensions (including leaders) : < " (itoa (sslength ss)) " >"))
   (princ "\n***  Nothing Selected  ***")
 )
 (sssetfirst nil ss)
 (princ)
)

(defun c:QS_BLOCKS ( / def lst sel )
; FN by Lee Mac http://www.cadtutor.net/forum/showthread.php?92638-Simple-fix-%28LISP-noob%29-Syntax-problem&p=633824&viewfull=1#post633824
   ;; Iterate over the block table and compile a list of xref blocks to exclude
   (while (setq def (tblnext "block" (not def)))
       (if (= 4 (logand 4 (cdr (assoc 70 def))))
           (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
       )
   )
   ;; Attempt to retrieve a selection of blocks (but not xrefs)
   (if (setq sel (ssget (cons '(0 . "INSERT") (if lst (vl-list* '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '((-4 . "NOT>")))))))
       (princ (strcat "\nNumber of blocks: " (itoa (sslength sel))))
       (princ "\n***  Nothing Selected  ***")
   )
   (sssetfirst nil sel)
   (princ)
)

(defun c:QS_LINES_VERTHORZ_ONLY (/ _Ang *error* kw s ss i sn e)
 ;;----------------------------;;
 ;; Tharwat 13. Dec. 2012    ;;
 ;; Modified on 01/06/2015    ;;
 ;;----------------------------;;
 ;; FN by Tharwat - Visit:http://www.cadeverything.com/help/showthread.php/7483-Vertical-horizontal-lines/page2
 (defun _Ang (e)
   (angle (cdr (assoc 10 e)) (cdr (assoc 11 e)))
 )
 (defun *error* (msg) (princ "\n Error...*Cancelled*"))
 (if
   (and
     (progn
       (initget "Vertical Horizontal Both")
       (setq
         kw (cond
              ((getkword
                 "\n Specify one [Vertical/Horizontal/Both] <Both> :"
               )
              )
              (t "Both")
            )
       )
     )
     (setq s  (ssadd)
           ss (ssget '((0 . "LINE")))
           ;ss (ssget "_x" (list '(0 . "LINE") (cons 410 (getvar 'ctab))))
     )
   )
    (progn
      (repeat (setq i (sslength ss))
        (setq sn (ssname ss (setq i (1- i)))
              e  (entget sn)
        )
        (cond ((eq kw "Vertical")
               (if (or (equal (_Ang e) (* pi 0.5) 1e-
                       (equal (_Ang e) (* pi 1.5) 1e-
                   )
                 (ssadd sn s)
               )
              )
              ((eq kw "Horizontal")
               (if (or (equal (_Ang e) pi) (equal (_Ang e) 0. 1e-)
                 (ssadd sn s)
               )
              )
              (t
               (if (or (equal (_Ang e) (* pi 0.5) 1e-
                       (equal (_Ang e) (* pi 1.5) 1e-
                       (equal (_Ang e) pi 1e-
                       (equal (_Ang e) 0. 1e-
                   )
                 (ssadd sn s)
               )
              )
        )
      )
      (sssetfirst nil s)
    )
 )
 (princ)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
(princ
   (strcat
       "\n:: 3DwannaB_Quick_Select_Commands.lsp | Version 1.0 | by 3DwannaB         ::"
       "\n:: Type \"QS_POLY_OPEN\" or \"QS_*\" to Invoke commands              ::"
   )
)
(princ)

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

Place this lisp file with the code in your support file search path folder Add the line to your acaddoc.lsp file which will load on demand the commands:

(AUTOLOAD "3DwannaB_Quick_Select_Commands" '("QS_BLOCKS_ANNOTATIVE" "QS_LINES_POLYLINES_ARCS_CIRCLES" "QS_POLY_OPEN" "QS_POLY_CLOSED" "QS_POLY_ALL" "QS_HATCH_ALL" "QS_HATCH_ASSOC" "QS_HATCH_NON_ASSOC" "QS_TEXT_SINGLE" "QS_TEXT_MULTILINE" "QS_TEXT_ALL" "QS_DIMS_ALL" "QS_BLOCKS" "QS_LINES_VERTHORZ_ONLY"))

 

Where 3DwannaB_Quick_Select_Commands is the name of the lisp file.

 

Another one I have selects all on current layer:

;;---------------=={ 3DwannaB_Sel_Layer_Current.lsp }==-----------------;;
;;                                                                      ;;
;;  Selects All Objects On Current Later                                ;;
;;----------------------------------------------------------------------;;
;;  Author: 3DwannaB, Copyright © 2015                                  ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    23-05-2015                                      ;;
;;                                                                      ;;
;;  First Release. Lots of help from 'Lee Mac' Credit goes to 'Tharwat' ;;
;;  See http://bit.ly/1HzZrlM                                             ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;

(defun c:SEL_LAYER_CURRENT (/ s )
   (if (setq s (ssget "_X" (list (cons 8 (getvar "CLAYER")))))
       (princ (strcat "\nNumber of Found objects : < " (itoa (sslength s)) " >"))
   )
   (sssetfirst nil s)
   (princ)
)
;;----------------------------------------------------------------------;;
(princ
   (strcat
       "\n:: 3DwannaB_Sel_Layer_Current.lsp | Version 1.0 | by 3DwannaB  ::"
       "\n:: Type \"Sel_Layer_Current\" to Invoke                          ::"
   )
)
(princ)
;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;