;;
;;      Here's a collection of some of my functions
;;            I've posted on CAD newsgroups.
;;
;;--------------------------------------------------------------
;;(c.) 1996-1997 by Vladimir Nesterovsky 
;;
;;  You're free to use this *COMPLETELY UNALTERED* with all the
;;        comments intact for any *NON-COMMERCIAL*
;;     purpose (or you must contact me for permission).
;;          NO WARRANTIES ARE GIVEN WATSOEVER.
;;               USE IT AT YOUR OWN RISK.
;;
;;  You must retain this header when using any part of this file
;;                      in any way
;;--------------------------------------------------------------
;;
;;        ( if you wish you may remove all the multy-line
;;        comments between ;| and |;, BUT you must retain
;;               regular one-line ;; comments intact. )
;;
;;    IF YOU HAVE ANY THOUGHTS OR COMMENTS PLEASE LET ME KNOW



;|
Subject: FW: attribute extraction -- alt.cad.autocad

>On 22 Apr 1996 13:31:29 GMT, "Henry C. Francis"  wrote in
>alt.cad.autocad:

>Eddie=ONeal%pcb=Components%PCPD=Hou@Bangate.Compaq.com wrote:
>>...I am trying to extract
>>the "TAG" variable out of the dwg database. I have been pulling my
>>hair out trying to figure this one out. I have tried (SSGET "X" '(( 0
>> "ATTRIB"))) and ((2 . "FORMD1")) - The name of the block ? is
>>FORMD1. Are the enitites nested inside of the block ? How can I get
>>them out.
> .....

Hello all.
I just wanted to add here a couple of thoughts.
1. The standard AutoLISP way to retreive TAGs info
  might be (using some of functions I've developed)
        (setq info
         (getk '(2 . 1)          ;; pairs of {TAG . VALUE}
          (mapcar 'cdr        ;; get rid of INSERTs
           (mapcar 'edlgetent ;; lists of entities' definition lists
                (sel2lst          ;; list of enames
                 (ssget "X"       ;; of selection set
                  '((0 . "INSERT")(2 . "YOUR_BLOCK_NAME_HERE"))
        ))))))
  and then
        (setq result (getk "YOUR_TAG_NAME" info))
  getting the list of retreived tags values (possibly containing
  some NILs for BLOCK INSERTs without specified ATTRIButes).
  EDLGETENT simply steps through entities from INSERT
  by ATTRIBs to SEQEND, gathering ENTGET's results in list. SEL2LST
  converts selection set into list of enames (using SSNAME  and also
  building list of results). The GETK is a tricky one. It's recursive
  function, which essentially does (CDR(ASSOC *CODE* *VAL*)), but
  becase of it's recursive nature, it keeps the structure of lists
  being operated upon. You may find all of them at Reini Urban's
  AutoCAD WWW site at  and search
  for "Tricky LISP examples" (sorry I couldn't find exact URL).
  Here goes EDLGETENT:
|;

;; Returns list of ENTGETs of entity and all it's subentities
(defun edlgetent( e ;; e-name arg.
                / d edl)
  (setq d (entget e) edl (list d))
  (if (= 1 (getk 66 d)) ;; entities follow
    (while (/= "SEQEND" (getk 0 (setq d
             (entget (setq e (entnext e))))))
      (setq edl (cons d edl))
  ))
  (reverse edl) ;; list of entget's Entity Data Lists
                ;; {without SEQEND in it}
)

;|
  Now for the BAD news. IT'S SLOW. It's slow because  ENTGET
  IS SLOW. We have no way to access the actual entity data for
  retrieval. Instead, ENTGET does a copy of all the properties
  of entity. I guess it's for not to allow erroneous altering
  of entity definition (which would damage actual DWG database).
  But I have no way to just RETRIEVE SOME DATA (Tag and Value in
  this case). They say it's in ARX... Well for now the ATTEXT may
  be a solution, and this is --

2. Use ATTEXT with appropriate template file. It's MUCH faster
  than any LISP or ADS (because ads_entget() in ADS is slow also).
  I guess ATTEXT has direct access to entity data without any
  copying of irrelevant information, so it's FAST.
  Use CDF to build comma delimited file. Then read it in form
  of list of strings, each representing a file row. If you have more
  than one TAG, you'll get all of them comma delimited, then you may
    (setq info (getfile "YOUR_TEMP_FILE_AFTER_ATTEXT"))
  and
    (setq result (mapcar '(lambda(row)(strparse row ",")) info))
  Here you get list of ordered lists of TAG VALUES (their order
  determines of which tag this value is) instead of list of lists
  of pairs {TAG . VALUE}, like in the 1st example. STRPARSE is also at
  Urban's site. It converts void tokens to nil so that "1,,3"
  translates into '("1" nil "3"), which is important here.
  GETFILE may be smthng like
|;

;; Returns list of file's rows as strings
(defun getfile( fname   ;; fname is a STRing file name
        / fd row lst)   ;; to read
  (cond
    ((setq fd (open fname "r"))
      (while (setq row (read-line fd))
        (setq lst (cons row lst)))
      (setq fd (close fd))
      (reverse lst))))

;|
Hope this all helps someone.
Good luck you all --

-------- END OF ORIGINAL MESSAGE --------

 Vladimir Nesterovsky      LISP/C/C++ etc.
   04/30/96 03:40:05
|;

;; convert SELection set to LiST of e-names
(defun sel2lst ( sel / l len )
  (if (= 'PICKSET (type sel))
   (repeat (setq len (sslength sel))
    (setq len (1- len) l (cons (ssname sel len) l)))))
;;or another alias for that
(setq sstol sel2lst)

;;the opposite --
(defun lst2sel(l / ss)(setq ss (ssadd))(foreach e l (ssadd e ss)))
(setq ltoss lst2sel)

(defun get1 (a b) (cdr (assoc a b)))

;; General GETK { get key(s) value(s) from list(s) } function
;; inspired by Tony Tanzillo's (get key_or_keys_list from_list)
;; from CHELEV.LSP on R12 Bonus CD, but
;; goes much further in recursion on both KEYs and LISTs
;; (thus retaining their structure upon return)
(defun GETK (k l)      ;;;;; GET KEY(s) FROM LIST(s)
  (if (atom (caar l)) ;; l is ASSOC'able list
    (cond             ;; use this l!
      ((atom k)       ;; k is a key
        (get1 k l))
      ( ;;(and (cdr k)(atom (cdr k))) ;; '(0 . 8) -->> ("ENTITY" . "LAYER")
        (cdr (last-cdr k))   ;; '( 0 8 . 10 ) -->> ("entity" "layer" x y z)
        (cons (getk (car k) l) (getk (cdr k) l)))
      (T              ;; k is a list of something - get inside
        (mapcar '(lambda(subk)(getk subk l)) k) )
    )                 ;; else - get inside list
    (mapcar '(lambda(subl)(getk k subl)) l)
))

(defun last-cdr (alist)   ;; 12 Feb 1999
 (while (not (atom (cdr alist)))
   (setq alist (cdr alist)))
 alist)

;|
I use it a lot. For example, to get all blocks in file with some
additional info - it's just one line of code, like

 (getk
  '(2 8 10 (41 42 43) 50)
   (mapcar 'entget (sel2lst(ssget"X"'((0 . "INSERT"))))))  --- voila!

Another application for EDLGETENT and GETK is ---

On Wed, 22 May 1996 08:37:44 +1000, Simon Hutchison
 wrote in comp.cad.autocad:

>Does anyone know how to extract the start and end points
>of each line in a polyline without exploding it?

Hi SIMON.

It's simple with "miraculous" GETK and EDLGETENT functions:
|;
(defun getverts( en )
  (getk 10 (cdr
    (edlgetent en))))
;|
Or let's say you want to get the bulges too, and
create list of points and bulges, PB-list, so
|;
(defun getpb-list( en )
  (getk '(10 42) (cdr
    (edlgetent en))))


;;Here is the routine that checks substring presence in second
;;string and returns it's index(base 1) if so, or nil.
(defun isinstr( ssub sall / lsub lall i n ret) ;; the best LISP version (??)
  (setq lall (strlen sall)
        lsub (strlen ssub)
  )
  (cond
    ((> lsub lall) nil)
    ((< lsub lall)
      (setq i 1 n (1+ (- lall lsub)))
      (while (and (not ret) (<= i n))
        (if (= ssub (substr sall i lsub))
          (setq ret i)
          (setq i (1+ i))
        )
      )
      ret
    )
    (T
      (if (= ssub sall) 1)
)))

(defun cdnr ( n l )
  (repeat n (setq l (cdr l))))


;|
From vnestr@netvision.net.ilMon Apr 15 14:10:15 1996
Date: Fri, 12 Apr 1996 01:01:45 GMT
From: Vladimir Nesterovsky 
To: Malcolm Robert Dingle 
Cc: Reini Urban 
Subject: Re: HELP, autolisp, newbie

malcolm@foxbat.sur.uct.ac.za (Malcolm Robert Dingle) wrote:

>Hi all

>I am looking at using (read-line) to read in a line from the file. However
>this reads input as a string. If I then used (read) on the string the first
>value in the string would be returned as a int/float (in this example it
>would return 10) but I can't see how to read the other values (ie 30 and
>40). Is it not possible to tell it to read the second value in the string?

> I come from a C background where I
>am used to having more options for reading input from a file than I can
>count :-) so being able to find only a couple of commands to read from a
>file seems a little foreign to me.

Hello,
You do have more options for input. Consider doing fgets()
and then converting parts of string by atoi() etc { in C }.
You can do the same in LISP with
 (setq line (read-line file)) and (atoi (substr line 1 5)), or
 (atof (substr line 7)) etc.
Of course it's only good for file in fixed format, for free
format you need to parse the string {like strtok() in C do},
breaking it on spaces {and/or commas etc} and converting
the string into list of strings==tokens, then apply whatever
function you want on elements of this list { these strings
may represent INTs, REALs, STRs, SYMs etc} with MAPCAR or smtng.
Here is general parsing function in LISP:
|;


;; strtol convert string of chars into list of 1-char strings
(defun strtol ( s / lst c )
  (repeat (setq c (strlen s))
    (Setq lst (cons (substr s c 1) lst)
          c   (1- c)
  ))
  lst
)

;; helper function
(defun strp(s)(and(='STR(type s))(/= s "")))

;; STRTOK  - break strng on char if it's in chs (char-string).
;; Like "C" strtok() break string to tokens delimited by one
;;   OR MORE chars.
;; parse free format -- no empty tokens --
;;   (strtok " 1,,  2,  3," " ,")->{"1" "2" "3"}
(defun strtok(strng chs / len c l s cnt chsl )
  (setq chsl (strtol chs))
  (setq len (strlen strng) s "" cnt (1+ len))
  (while (> (setq cnt (1- cnt)) 0)
    (setq c (substr strng cnt 1))
    (if (member c chsl)
      (if (strp s)
        (setq l (cons s l) s "")
      )
      (setq s (strcat c s))
    )
  )
  (if (strp s)
    (cons s l)
    l
  )
)

;;If you want to catch null tokens too, like
;; "1,,3,4" -->> { "1" "" "3" "4" }, you'll need this:

;;STRPARSE FOR PARSING STRING (and keeping null tokens)
(defun strparse(strng chs / len c l s chsl cnt );;delim==one-of-chs.
  (setq chsl (strtol chs))
  (setq len (strlen strng) s "" cnt (1+ len))
  (while (> (setq cnt (1- cnt)) 0)
    (setq c (substr strng cnt 1))
    (if (member c chsl)
      (if (/= cnt len);; "1,2," -> ("1" "2") and not ("1" "2" "")
        (setq l (cons s l) s "")
      )
      (setq s (strcat c s))
    )
  )
  (cons s l)   ;; ",1,2" -> ("" "1" "2")
)
;|
So now, armed with this string manipulation functions, we may
 (setq line (read-line file)
       lst  (strtok line ", ")
       nums (mapcar 'atoi lst))
etc.

Or with an aid of GETFILE
|;
(defun getnums (fname)
 (mapcar'(lambda(row)
  (mapcar 'atoi
    (strtok row ", ")))
  (getfile fname)))
;|
Possible improvements: do C_STRTOK() and C_STRPARSE()
in ADS and export them to LISP from there. It must be
much much faster.

=Vladimir Nesterovsky   LISP/C/C++ etc 
|;


;|
From: Vladimir Nesterovsky 
To: rurban@sbox.tu-graz.ac.at
Subject: Re: (entsel) vs (getpoint) for getting TEXT entity...

On 27 Apr 1996 14:50:46 GMT, rurban@xarch.tu-graz.ac.at (Reini Urban)
wrote in comp.cad.autocad:

>VistaMikeF (vistamikef@aol.com) wrote:
>: (entsel) returns a point, but only if an entity is selected.
>: (getpoint) returns a point automatically, but doesn't have the cute little
>: square pick that is used with (entsel), and it would be pretty darn
>: difficult to determine whether that point is near the text because the
>: text could be arbitrary...

>use (grread nil 2 4) or similar
>it returns the point and shows this pickbox. then check with (ssget pt)

>Ex:
>(if (and (setq x (grread nil 2 4))
>         (setq pt (cadr x)))
>  (if (and (setq ss (ssget pt))
>           (= (cdr (assoc 0 (setq ent (ssname ss 0)))) "TEXT"))
>    ;; text found
>    (command "DDEDIT" ent)
>    ;; else create new
>    (command "TEXT" ...)
>  )
>)

>not tested.

>---
>Reini Urban  http://xarch.tu-graz.ac.at/~rurban/

Hello.
Yes, using GRREAD seems to be the only way.
The little trick here is to convert a point to Display
Coordinate System, and then it all will work just fine
even on twisted (rotated) views.
If you want to be perfect, you might collect a keystrokes from user
(I'm ignoring them for simplicity) and respond to some keywords etc.

Here's something tested and used:
|;


;; SELect ENTities by picking a point
;; main routine to use
(defun sel-ents( / p q got_inpt)  ;; ret {{e1 [e2 ... en]} pt}
  (while (not got_inpt)
    (setq p (grread nil 4 2)) ;; show pick-cursor shape
    (if
      (or (= (car p) 3)
          (member p    ;; allow to exit via Return/Esc
            '((2 3)(2 10)(2 13)(2 32)(2 27))))
      (setq got_inpt T)
  ))
  (if (and (= 3 (car p)) ;; got UCS point from GRREAD
           (setq q (selfindp (setq p (cadr p)) 1)) )
    (list q p)  ;; return {{e1 [e2 ... en]} pt}
))

;; Selection-Entities-List Find by Point
(defun selfindp (p xcs / FUZZ sel p1 p2 )
                ;;xcs: 0-- p is WCS, 1 -- UCS, etc.
                ;;RET EN-LIST of all entities near point
  (graphscr)       ;; a must for (SSGET "C"...) to work(?)
  (setq FUZZ (* (pixelsize) (getvar "pickbox")))
  (setq p  (trans p xcs 2) ;; translate to DisplayCS
        p1 (mapcar '- p (LIST FUZZ FUZZ))
        p2 (mapcar '+ p (LIST FUZZ FUZZ))
        sel(ssget "C" (trans p1 2 1) (trans p2 2 1))
  )
  (sel2lst sel)
)

;; Pixel Size in drawing units
(defun pixelsize()
  (/ (GETVAR "viewsize") (CADR (GETVAR "screensize"))))


;| some more stuff:
On 21 May 1996 15:38:20 -0400, aracad@aol.com (ARACAD) wrote in
comp.cad.autocad:

>How in the world can I use stretch and allow for user removal from the
>sset?  You never know how many pauses to enter for removal etc.

>help would be much appreciated
>ARACAD

Try
(defun c:dostretch()
 (command "stretch")
 (while(= 1 (logand (getvar"cmdactive") 1))
  (command"pause"))
) |;

;; General check-bit and set-bit functions:
(defun check-bit(bit value) ;; bit is zero based
 (= (setq bit (lsh 1 bit))(logand value bit)))
(defun set-bit(bit value) ;; bit is zero based
 (logior value (lsh 1 bit)))
(defun clear-bit(bit value)
 (logand value (~ (lsh 1 bit))))

;| just something curious:

On 20 Jun 1996 09:44:43 -0400, daemon@cs.yale.edu martin.zurn@jrc.it (Martin) wrote in comp.cad.autocad:

>I wanted to load several thaousand points from a file
>that looks like

>...
>0.4860,4.1984,1.0300
>0.4810,4.2250,1.0300
>0.4729,4.2565,1.0300
>0.0699,4.0517,1.0400
>0.0885,4.0411,1.0400
>The nicest answer seems to be a lisp script
>calling the POINT command repeatedly [...]

Hello,
Did you know that SCRIPT may be invoked TRANSPARENTLY?
So if you have all your points in file in the form
like here in your posting, you must just save it
under some name with SCR extension, like PTS.SCR, and then
 MULTIPLE POINT 'SCRIPT PTS ^C
will do the job (I mean your *LIST* file *IS* your script file,
with no need to alter).

Seems to me the simplest way to do that.
|;



;|
On 3 May 1996 22:17:23 -0400, vistamikef@aol.com (VistaMikeF) wrote in comp.cad.autocad:

>Hello all-

>    I can do an (entget) on a VIEWPORT and get its lower left (DXF group...
>(entget (entlast))
>((-1 . )
> (0 . "VIEWPORT")        ; means the thing is a viewport
> (8 . "0")       ; means it's on the "0" layer
> (67 . 1)        ; means it's in paper space
> (10 5.72 5.25 0)     ; means that (5.72,5.25) is the lower left corner
> (40 . 5.73)     ; means that its "height" is 5.73
> (41 . 5.30)     ; means that its "aspect ratio" is 5.30
> (69 . 2)       ; means that its "ID" is 2
> (68 . 1)       ; means that its "Status Field" is 1
>)

>Now is there some way to query based on the ID what model-space
>coordinates are visible in the viewport?

Hello, Mike.

40 and 41 group here is height/width in paper space units.
You need to examin its Extended Data to go into that sort of
information. Try these: |;

(defun getlistxdata(enam appnam / x)
  (if (setq x (entget enam (list appnam)))
    (mapcar 'cdr
      (cdr(assoc appnam
        (cdr(assoc -3 x)
))))))
(defun c:showxdata()
  (getlistxdata
    (car(entsel"\nPick a VIEWPORT: "))
    "ACAD"))
;|
In the resulting list the order of values counts. Try to identify
what's what -- sorry, I just don't remember right now, but it
shouldn't be too hard.
|;

;|
On 27 May 1996 14:52:14 GMT,  rurban@xarch.tu-graz.ac.at (Reini
Urban) wrote in alt.cad.autocad:

>How can I change viewports in AutoLISP?
>There is a key (I forgot) and usually I do it with the cursor. But how to do
>it with plain AutoLISP.
>Is there an easy way?

Hi Reini.

What I'm doing when forgetting object codes, is |;

(defun c:entlist()
  (print(entget(car(entsel
    "\nPick an object to be examined, please: "
)))))

;|As for viewport ID it's 68 or 69 group for VIEWPORT,
I don't remember right now. Check CVPORT while being
inside, the go out to PS and check the VIEWPORT codes
with ENTLIST.
To restore, just (setvar"CVPORT" vp-id).

Paper Space itself is a special kind of VIEWPORT, it's
always there, always invisible (borders, I mean) and
always has CVPORT of 1, hence the famous
routine I once saw (on Bonus CD I think)
|;
;;NOT MINE! just saw it elsewhere
(defun is_paper()(> 2 (getvar "cvport") (getvar "tilemode")))

;|On Wed, 22 May 1996 19:40:38 GMT I wrote in comp.cad.autocad:

On Fri, 17 May 1996 21:57:00 GMT, jeeper@halcyon.com (Dennis Shinn)
wrote in comp.cad.autocad:

>Christopher Carr  wrote:

>>      When using autocadd r10, there was a command "redraw" I think it was
>>that cleared up curved edges.  I'm using r13 now and I can't understand why
>>this command isn't working now.
>..................
>REGEN, on the other hand, does re-calculate the display list. It also has the
>effect of smoothing out curved lines after a zoom magnification that didn't
>force a regen in order to do so automatically. Thus, depending on the setting
>of your VIEWRES system variable, it's quite possible to get jagged edges on
>curved surfaces that have been drawn at one zoom magnification factor then
>viewed at a closer one.

Hi all,
Here is a simple routine that regenerates only entities you select,
so if you want to smooth just some of your arcs, you may avoid
REGENs with this one: |;

(defun c:reent()
;;  (foreach e (sel2lst (ssget))(entupd e)))
;;  (ss-foreach (ssget) 'entupd))
  (for-sset (ssget) entupd))

;; here r-ss-foreach is better because we won't waste a lot of memory
;; just for intermediate list.
;; here it is, as published by me on 1st March, 1997 on cca, with some minor bug fix:
;;{it's done in reverse order, because the function is more compact that way.}

(defun r-ss-foreach ( ss qfoo / n )
 (if (= 'PICKSET (type ss))
  (repeat (setq n (fix (sslength ss))) ;; a little fix
   (apply qfoo (list (ssname ss (setq n (1- n))))))))

;; like r-ss-foreach repeat (foo e-name) for each e-name
;; in SelSet only in _right_ order
(defun ss-foreach ( ss qfoo / n ) ;; a quoted function
 (if (= 'PICKSET (type ss))
  (repeat (progn (setq n -1) (fix (sslength ss)))
   (apply qfoo (list (ssname ss (setq n (1+ n))))))))

;;
;;;;; here's the one to use: it's 15% faster then the other versions!
;;
(defun FOR-SSET (sset f / n)
 (if (= 'PICKSET (type sset))
  (repeat (progn (setq n -1) (fix (sslength sset)))
   (f (ssname sset (setq n (1+ n)))))))


;;-------------------------------------------
;; End Of VNESTR.LLB
;; (C.) Vladimir Nesterovsky 
;;          http://www.netvision.net.il/php/vnestr/
;; (defun strf(field s)(c_printf "%.*s" (fix field) s))
;;-------------------------------------------
;;
;;  Live long and prosper :)
Make your own free website on Tripod.com