Search the FAQ Archives

3 - A - B - C - D - E - F - G - H - I - J - K - L - M
N - O - P - Q - R - S - T - U - V - W - X - Y - Z
faqs.org - Internet FAQ Archives

comp.cad.autocad AutoLISP FAQ (part 2/2) - samples, code
Section - [20] General helper functions

( Part1 - Part2 - Single Page )
[ Usenet FAQs | Web FAQs | Documents | RFC Index | Business Photos and Profiles ]


Top Document: comp.cad.autocad AutoLISP FAQ (part 2/2) - samples, code
Previous Document: News Headers
Next Document: [21] Sample Lisp Programs:
See reader questions & answers on this topic! - Help others by sharing your knowledge
  For more general AutoLISP functions please see the AutoLISP Standard
  Library at http://xarch.tu-graz.ac.at/autocad/stdlib/
  Other code is also available at some AutoLISP sites [1] or included in
  the SDK's by AutoDESK [1.2]

  I included here some very useful helper functions for shorter
  samples in answers on the net.
  You could rely on the fact that these functions are in common
  knowledge such as the famous dxf function, which is defined as
  (defun dxf (grp ele) (cdr (assoc grp ele))) and the specific
  counterpart (getval) which works with either an ename or entget list.

[20.1] List manipulation

  See also http://xarch.tu-graz.ac.at/autocad/stdlib/STDLIST.LSP
  Useful sample functions for *list manipulation* are:

  ;;; a not empty list?
  (defun CONSP (x) (and x (listp x)))

  ;;; returns the index of the first element in the list,
  ;;; base 0, or nil if not found
  ;;;   (position 'x '(a b c)) -> nil, (position 'b '(a b c d)) -> 1
  (defun POSITION (x lst / ret)
    (if (not (zerop (setq ret (length (member x lst)))))
      (- (length lst) ret)))

  ;;; Removes an item from a list (double elements allowed)
  ;;;   (remove 0 '(0 1 2 3 0)) -> (1 2 3)
  (defun REMOVE (ele lst)      ; by Serge Volkov
    (apply 'append (subst nil (list ele) (mapcar 'list lst))))

  ;;; Conditional remove from flat list,
  ;;; pred requires exactly 1 arg
  ;;;   (remove-if 'zerop '(0 1 2 3 0)) -> (1 2 3)
  ;;;   (remove-if 'numberp '(0 (0 1) "")) -> ((0 1) "")
  (defun REMOVE-IF (pred from)
    (cond
      ((atom from) from)       ;nil or symbol (return that)
      ((apply pred (list (car from))) (remove-if pred (cdr from)))
      (t (cons (car from) (remove-if pred (cdr from))))
    )
  )

  ;;; Keeps all elements to which the predicate applies
  ;;; Say: "keep if", it need not be defined recursively, also like this.
  ;;; [fixed, thanks to Serge Pashkov, in FAQ-CODE.LSP it was okay]
  (defun REMOVE-IF-NOT (pred lst)        ; by Vladimir Nesterowsky
    (apply 'append
           (mapcar '(lambda (e)
                    (if (apply pred (list e)) (list e))) lst)))

  ;;; Conses ele to list if not already in list
  ;;; Trick: Accepts quoted lists too, such as
  ;;;   (setq l '(1 2 3) (adjoin 0 'l)
  ;;;    -> !l (0 1 2 3)
  (defun ADJOIN (ele lst / tmp)
    (if (= (type lst) 'SYM) (setq tmp lst lst (eval tmp)))
    (setq lst (cond ((member ele lst) lst)
                    (t (cons ele lst))))
    (if tmp (set tmp lst) lst)
  )

  ;;; put the first element to the end, simple version
  ;;; ("rotate by one")
  (defun ROT1 (lst) (append (cdr lst) (list (car lst))))

  ;;; the list without the last element
  (defun BUTLAST (lst)
    (reverse (cdr (reverse lst))))

------------------------------

[20.2] String manipulation

  Please check http://xarch.tu-graz.ac.at/autocad/stdlib/STDSTR.LSP
  Some useful *string functions* would be:

  Predicates:
    (stringp expr)          - string predicate, is expr a string?
      (defun stringp (s) (= (type s) 'STR))

    (string-not-emptyp str) - is str a not empty string?
      (defun string-not-emptyp (s) (and (stringp s) (/= s "")))

  Trimming:
    (str-trim string)       - str without any whitespace, to the right
                           and left, defined in AI_UTILS.LSP as well as
    (str-left-trim string), (str-right-trim string)

    (str-left-trim-bag string bag), (str-right-trim-bag string bag)
                            - remove all chars in bag (=STR)
  Search:
    (strpos string substr)  - position of substring in string (1 based)

  Parsing and gathering functions, (list<->string):
    (strtok str tokens)     - string -> list delimited by tokens (SDK2)
    (strlcat lst delim)     - concat list -> string seperated by delim

    (string->list str)      - string -> list of chars
    (list->string lst)      - list of chars -> string

  All of them and much more are in the Stdlib (see above).
  Some are at http://xarch.tu-graz.ac.at/autocad/code/vnestr/strtok.lsp
  or in your AI_UTILS.LSP. You'll need them esp. for DCL functions.

------------------------------

[20.3] symbol->string

  The inverse function to (read) would be (symbol-name). The following
  is the only general way, but there exist better special methods.

  ;;; SYMBOL-NAME - returns the name of a symbol as string
  ;;; converts any valid lisp expression to its printed representation
  ;;; (symbol-name a) -> "a",  (symbol-name '(0 1 2 a)) -> "(0 1 2 A)"
  (defun SYMBOL-NAME (sym / f str tmp)
    (setq tmp "$sym.tmp")      ;temp. filename, should be deleted
    (setq f (open tmp "w"))(princ sym f) (close f)
    (setq f (open tmp "r") str (read-line f) f (close f))
    str)
  
  For plain symbols exists a better trick explained by Christoph
  Candido at http://xarch.tu-graz.ac.at/autocad/news/symbol-string.txt
  Vill/VLISP introduced a fast vl-symbol-name.
  See also http://xarch.tu-graz.ac.at/autocad/stdlib/STDINIT.LSP

------------------------------

[20.4] AutoCAD entity access [renamed SSAPPLY to SSMAP]

  See also http://xarch.tu-graz.ac.at/autocad/stdlib/STDENT.LSP

  ;;; returns the first group value of an entity.
  ;;; like the wellknown (dxf) function but accepts all kinds of
  ;;; entity representations (ename, entget list, entsel list)
  ;;; NOTE: For getting 10 groups in LWPOLYLINE's not usable!
  (defun GETVAL (grp ele)                 ;"dxf value" of any ent...
    (cond ((= (type ele) 'ENAME)          ;ENAME
            (cdr (assoc grp (entget ele))))
          ((not ele) nil)                 ;empty value
          ((not (listp ele)) nil)         ;invalid ele
          ((= (type (car ele)) 'ENAME)    ;entsel-list
            (cdr (assoc grp (entget (car ele)))))
          (T (cdr (assoc grp ele)))))     ;entget-list

  ;;; Ex: (gettyp pline) => "POLYLINE"
  (defun GETTYP (ele)                     ;return type
    (getval 0 ele))

  ;;; assure ENAME
  ;;; convert the entity to type ENAME (to write shorter code)
  (defun ENTITY (ele)                     ;convert to element name
    (cond				  ;accepts the following types:
      ((= (type ele) 'ENAME) ele)             ; ENAME
      ((not (listp ele)) nil)                 ; error: no list
      ((= (type (car ele)) 'ENAME) (car ele)) ; entsel-list
      ((cdr (assoc -1 ele)))                  ; entget-list or nil
    )
  )
  ;and now just:
  (defun getval (grp ele) (cdr (assoc grp (entget (entity ele)))))

  ;;; Ex: (istypep ele "TEXT")
  ;;; is element a "SOLID"?
  (defun istypep (ele typ)                   ;check type
    (= (gettyp ele) typ))

  ;;; Ex: (istypep ele '("TEXT" "ATTDEF"))
  ;;; is element a "TEXT" or a "ATTDEF"?
  (defun ISTYPEP (ele typ) ;better implementation to accept lists too
    (cond
      ((listp typ)   (member (gettyp ele) typ)) ;bugfixed
      ((stringp typ) (= (gettyp ele) typ))      ;assume typ uppercase
      (T nil)))

  ;;; Ex: (getpt (entsel))  => ( 0.1 10.0 24)
  (defun GETPT (ele)    ;return the startpoint of any element
    (getval 10 ele))    ;group 10

  ;;; Ex: (getflag pline)  => 1 if closed
  (defun GETFLAG (ele) (getval 70 ele)) ;same with the entity flag

  ;;; bitvalue val in flag of element set?
  ;;; Ex: (flagsetp 1 pline)   => T if closed
  ;;; Ex: (flagsetp 16 vertex) => T if spline control point
  (defun FLAGSETP (val ele)
    (bitsetp val (getflag ele)))

  ;;; Ex: (bitsetp 4 12) => T   ;bitvalue 4 (=2.Bit) in 12 (=4+8) is set
  (defun BITSETP (val flag)
    (= (logand val flag) val))

  ;;; convert selection set to list,
  ;;; Note: it's also wise to use ai_ssget, because some ents could be
  ;;;       on locked layers
  ;;; Ex: (sslist (ai_ssget (ssget))) => list of selected unlocked ents
  ;;; or  (mapcar 'entupd (sslist (ssget "X" '((8 . "TEMP")))))
  ;;;       - regens all entities on layer TEMP
  (defun SSLIST (ss / n lst)
    (if (= (type ss) 'PICKSET)
      (repeat (setq n (sslength ss))
        (setq n (1- n)
              lst (cons (ssname ss n) lst)))))

  ;;; apply a function to each ent in ss, in reversed order
  ;;; Faster, but not so easy to understand. see [22.2]
  ;;; [renamed from SSAPPLY to SSMAP to match the stdlib name]
  ;;; Ex: (ssmap 'entupd (ssget))   ; regenerate only some entities
  (defun SSMAP (fun ss / n)
    (if (= 'PICKSET (type ss))
      (repeat (setq n (sslength ss))
        (apply fun (list (ssname ss (setq n (1- n))))))))

User Contributions:

Comment about this article, ask questions, or add new information about this topic:

CAPTCHA




Top Document: comp.cad.autocad AutoLISP FAQ (part 2/2) - samples, code
Previous Document: News Headers
Next Document: [21] Sample Lisp Programs:

Part1 - Part2 - Single Page

[ Usenet FAQs | Web FAQs | Documents | RFC Index ]

Send corrections/additions to the FAQ Maintainer:
rurban@xarch.tu-graz.ac.at (Reini Urban)





Last Update March 27 2014 @ 02:11 PM