home *** CD-ROM | disk | FTP | other *** search
/ ftp.pasteur.org/FAQ/ / ftp-pasteur-org-FAQ.zip / FAQ / CAD / autolisp-faq / part2 < prev   
Encoding:
Internet Message Format  |  2004-05-01  |  50.2 KB
  1. From: rurban@x-ray.at (Reini Urban)
  2. Newsgroups: comp.cad.autocad,alt.cad.autocad,alt.answers,comp.answers,news.answers
  3. Subject: comp.cad.autocad AutoLISP FAQ (part 2/2) - samples, code
  4. References: <autolisp-faq-1-1083403804> 
  5. Reply-To: rurban@xarch.tu-graz.ac.at (Reini Urban)
  6. Followup-To: comp.cad.autocad
  7. Distribution: world
  8. Organization: TU Graz-Fac.of Architecture & X-RAY Graz
  9. Approved: news-answers-request@mit.edu
  10. Keywords: FAQ, AutoLISP, AutoCAD
  11. Summary: AutoLISP is a scripting language for AutoCAD, a wellknown CAD 
  12.   package. This AutoLISP FAQ is posted to comp.cad.autocad, alt.cad.autocad 
  13.   and *.answers monthly.
  14. NNTP-Posting-Host: oma.graz.inode.at
  15. Message-ID: <40936e27@e-post.inode.at>
  16. Date: 1 May 2004 11:30:15 +0200
  17. X-Trace: e-post.inode.at 1083403815 195.58.172.138 (1 May 2004 11:30:15 +0200)
  18. Lines: 1318
  19. Path: senator-bedfellow.mit.edu!bloom-beacon.mit.edu!news.rediris.es!newsmi-us.news.garr.it!NewsITBone-GARR!news.mailgate.org!newsfeed.stueberl.de!newsfeed.utanet.at!newscore.univie.ac.at!e-post.inode.at!not-for-mail
  20. Xref: senator-bedfellow.mit.edu comp.cad.autocad:164734 alt.cad.autocad:148003 alt.answers:72709 comp.answers:57014 news.answers:270655
  21.  
  22. Posted-By: auto-faq 3.2.1.5
  23. Archive-name: CAD/autolisp-faq/part2
  24. URL: http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp.html
  25. Version: 2.28
  26. Last-modified: 2002-06-25
  27. Posted-By: Reini Urban <rurban@x-ray.at>
  28. Posting-Frequency: monthly
  29. Copyright: see Appendix [A]
  30.  
  31.         Welcome to the comp.cad.autocad AutoLISP FAQ
  32.           by Reini Urban <rurban@x-ray.at>
  33.  
  34. AutoLISP is a scripting language for AutoCAD, a well known CAD package.
  35. This AutoLISP FAQ is posted to comp.cad.autocad, alt.cad.autocad and
  36. the *.answers groups monthly. Some AutoCAD FAQ's are at
  37. http://www.autodesk.com/support/autocad/ but not posted to
  38. comp.cad.autocad. The contents and the samples apply to all
  39. releases of AutoLISP since Release 10, including Visual Lisp, Vital Lisp
  40. and ACOMP. There's no special AutoLISP newsgroup.
  41. Best are comp.cad.autocad and autodesk.autocad.customization,
  42. but please don't bother comp.lang.lisp.
  43. Source code of all functions in this FAQ is in FAQ-CODE.LSP
  44. (for location see [A.1]), there's also a Winhelp file.
  45. Thanks to all who have contributed. Corrections and contributions
  46. always welcome. 
  47. Please see http://xarch.tu-graz.ac.at/acadwiki/RulesToLiveBy
  48.  
  49. This is part 2/2 of the AutoLISP FAQ v2.28, which consists of:
  50.  
  51.     AutoLISP FAQ (part 1/2) - General
  52.     AutoLISP FAQ (part 2/2) - Samples, code
  53.  
  54. | changes, + new in items from this version to the last posted version,
  55. intermediate personal comments and uncertainties in <..>
  56.  
  57.   -----------------
  58.   Table of Contents
  59.   -----------------
  60.   part 1:   General
  61.      [0] The Future of AutoLISP? Should I learn it or VB instead?
  62.        [0.1] What changed with AutoCAD 2000?
  63.        [0.2] We cannot create ARX anymore?
  64.      [1] Where can I find AutoLISP routines on the Internet?
  65.        [1.1] Are the comp.cad.autocad articles stored somewhere?
  66.        [1.2] Autodesk's SDK
  67.       [2] What are the best books to learn AutoLISP?
  68.        [2.1] Online AutoLISP documents, Winhelp [deleted]
  69.        [2.2] AutoLISP Coding Style
  70.      [3] How do I debug AutoLISP programs?
  71.         [3.1] Native AutoLISP debuggers
  72.         [3.2] Modular style, TRACE
  73.         [3.3] BREAK function, debug-print
  74.      [4] How can I protect my AutoLISP programs? Security
  75.        [4.1] Kelvinate
  76.        [4.2] Protect
  77.        [4.3] Kelvinate and Protect
  78.        [4.4] Convert
  79.        [4.5] ACOMP
  80.        [4.7] Lisp2C
  81.        [4.6] Vital LISP Professional
  82.        [4.8] Visual Lisp by Autodesk
  83.      [5] AutoLISP compilers
  84.        [5.1] ACOMP
  85.        [5.2] Vital LISP Professional
  86.        [5.3] Visual Lisp by Autodesk
  87.        [5.4] Better ones: Common Lisp and Scheme
  88.      [6] AutoLISP editors and other tools
  89.        [6.1] AutoLISP editors
  90.        [6.2] Analyzers, Packager and Parenthesis checkers
  91.        [6.3] Pretty Printers
  92.      [7] AutoLISP problems and bugs
  93.      [8] Sorting with AutoLISP
  94.      [9] Recursion
  95.      [10] Iteration with MAPCAR,...
  96. |    [11] S::STARTUP, My LISPs aren't loading at startup anymore
  97.      [12] How to AUTOLOAD my programs?
  98.      [13] How can I pass a variable number of
  99.           arguments to a LISP function?
  100. |    [14] How can I avoid stack overflows?
  101.      [15] (command "ROTATE3D") does not work! Why?
  102.      [16] Lisp programs operating over multiple drawings
  103.      [17] How to export Visual Lisp functions to AutoLISP/AutoCAD?
  104.      --
  105.      [A] Disclaimer, Notes from the authors
  106.        [A.1] FAQ Locations
  107.  
  108.   part 2:   Samples, code
  109.      [20] General Helper functions
  110.        [20.1] List manipulation
  111.        [20.2] String manipulation
  112.        [20.3] symbol->string
  113.        [20.4] AutoCAD entity access
  114.      [21] Sample Lisp programs
  115.        [21.1] Globally change text, polylines, layer utils, date stamp
  116.        [21.2] Plot dialog from within LISP. Using DDE or ActiveX
  117.        [21.3] (entmod),(entmake) Layers, without (command "_LAYER"...)
  118.        [21.4] How to select multiple files in LISP? (as in FILES-Unlock)
  119.        [21.5] Replace multiple blocks
  120.        [21.6] (vports), VIEWPORT entity, pixel conversion
  121.        [21.7] Select all visible objects: zoom coordinates
  122.        [21.8] How to write XYZ data of selected objects to a file?
  123.      [22] Block Attributes
  124.        [22.1] How to access block attributes?
  125.        [22.2] How to MODIFY block attributes? DATESTAMP.LSP
  126.        [22.3] How to UPDATE block attributes?
  127.        [22.4] How to ENTMAKE a Block Complex Entity in AutoLISP
  128.      [23] Polylines
  129.        [23.1] How to access polyline VERTICES?
  130.        [23.2] How to JOIN multiple lines to polylines?
  131.        [23.3] Change WIDTH of multiple polylines
  132.        [23.4] Create a polyline or spline: with (ENTMAKE) or (COMMAND)
  133.        [23.5] How to calculate the LENGTH of polylines?
  134.        [23.6] How to revert the polyline direction?
  135.        [23.7] How to get the CENTER of a polyline?
  136.      [24] Circle/Arc Geometry:  BULGE conversion, some trigonometry
  137.      [25] DCL: listboxes with tabs or monotext font
  138.      [26] EED Extended Entity Data: Get and Store
  139.        [26.1] Select objects on their EED with (ssget "X")
  140.        [26.2] Get EED from an object
  141.      [27] How to break a command in LISP?
  142.        [27.1] How to do an unlimited number user prompts?
  143.      [28] How to decode ACIS internal geometry with LISP
  144.      --
  145.      [A] Disclaimer, Notes from the author
  146. +      [A.1] FAQ Locations
  147.      [B] Acknowledgements
  148.      [C] Recent Changes
  149.  
  150. ----------------------------------------------------------------------
  151.  
  152. Subject: [20] General helper functions
  153.  
  154.   For more general AutoLISP functions please see the AutoLISP Standard
  155.   Library at http://xarch.tu-graz.ac.at/autocad/stdlib/
  156.   Other code is also available at some AutoLISP sites [1] or included in
  157.   the SDK's by AutoDESK [1.2]
  158.  
  159.   I included here some very useful helper functions for shorter
  160.   samples in answers on the net.
  161.   You could rely on the fact that these functions are in common
  162.   knowledge such as the famous dxf function, which is defined as
  163.   (defun dxf (grp ele) (cdr (assoc grp ele))) and the specific
  164.   counterpart (getval) which works with either an ename or entget list.
  165.  
  166. [20.1] List manipulation
  167.  
  168.   See also http://xarch.tu-graz.ac.at/autocad/stdlib/STDLIST.LSP
  169.   Useful sample functions for *list manipulation* are:
  170.  
  171.   ;;; a not empty list?
  172.   (defun CONSP (x) (and x (listp x)))
  173.  
  174.   ;;; returns the index of the first element in the list,
  175.   ;;; base 0, or nil if not found
  176.   ;;;   (position 'x '(a b c)) -> nil, (position 'b '(a b c d)) -> 1
  177.   (defun POSITION (x lst / ret)
  178.     (if (not (zerop (setq ret (length (member x lst)))))
  179.       (- (length lst) ret)))
  180.  
  181.   ;;; Removes an item from a list (double elements allowed)
  182.   ;;;   (remove 0 '(0 1 2 3 0)) -> (1 2 3)
  183.   (defun REMOVE (ele lst)      ; by Serge Volkov
  184.     (apply 'append (subst nil (list ele) (mapcar 'list lst))))
  185.  
  186.   ;;; Conditional remove from flat list,
  187.   ;;; pred requires exactly 1 arg
  188.   ;;;   (remove-if 'zerop '(0 1 2 3 0)) -> (1 2 3)
  189.   ;;;   (remove-if 'numberp '(0 (0 1) "")) -> ((0 1) "")
  190.   (defun REMOVE-IF (pred from)
  191.     (cond
  192.       ((atom from) from)       ;nil or symbol (return that)
  193.       ((apply pred (list (car from))) (remove-if pred (cdr from)))
  194.       (t (cons (car from) (remove-if pred (cdr from))))
  195.     )
  196.   )
  197.  
  198.   ;;; Keeps all elements to which the predicate applies
  199.   ;;; Say: "keep if", it need not be defined recursively, also like this.
  200.   ;;; [fixed, thanks to Serge Pashkov, in FAQ-CODE.LSP it was okay]
  201.   (defun REMOVE-IF-NOT (pred lst)        ; by Vladimir Nesterowsky
  202.     (apply 'append
  203.            (mapcar '(lambda (e)
  204.                     (if (apply pred (list e)) (list e))) lst)))
  205.  
  206.   ;;; Conses ele to list if not already in list
  207.   ;;; Trick: Accepts quoted lists too, such as
  208.   ;;;   (setq l '(1 2 3) (adjoin 0 'l)
  209.   ;;;    -> !l (0 1 2 3)
  210.   (defun ADJOIN (ele lst / tmp)
  211.     (if (= (type lst) 'SYM) (setq tmp lst lst (eval tmp)))
  212.     (setq lst (cond ((member ele lst) lst)
  213.                     (t (cons ele lst))))
  214.     (if tmp (set tmp lst) lst)
  215.   )
  216.  
  217.   ;;; put the first element to the end, simple version
  218.   ;;; ("rotate by one")
  219.   (defun ROT1 (lst) (append (cdr lst) (list (car lst))))
  220.  
  221.   ;;; the list without the last element
  222.   (defun BUTLAST (lst)
  223.     (reverse (cdr (reverse lst))))
  224.  
  225. ------------------------------
  226.  
  227. [20.2] String manipulation
  228.  
  229.   Please check http://xarch.tu-graz.ac.at/autocad/stdlib/STDSTR.LSP
  230.   Some useful *string functions* would be:
  231.  
  232.   Predicates:
  233.     (stringp expr)          - string predicate, is expr a string?
  234.       (defun stringp (s) (= (type s) 'STR))
  235.  
  236.     (string-not-emptyp str) - is str a not empty string?
  237.       (defun string-not-emptyp (s) (and (stringp s) (/= s "")))
  238.  
  239.   Trimming:
  240.     (str-trim string)       - str without any whitespace, to the right
  241.                            and left, defined in AI_UTILS.LSP as well as
  242.     (str-left-trim string), (str-right-trim string)
  243.  
  244.     (str-left-trim-bag string bag), (str-right-trim-bag string bag)
  245.                             - remove all chars in bag (=STR)
  246.   Search:
  247.     (strpos string substr)  - position of substring in string (1 based)
  248.  
  249.   Parsing and gathering functions, (list<->string):
  250.     (strtok str tokens)     - string -> list delimited by tokens (SDK2)
  251.     (strlcat lst delim)     - concat list -> string seperated by delim
  252.  
  253.     (string->list str)      - string -> list of chars
  254.     (list->string lst)      - list of chars -> string
  255.  
  256.   All of them and much more are in the Stdlib (see above).
  257.   Some are at http://xarch.tu-graz.ac.at/autocad/code/vnestr/strtok.lsp
  258.   or in your AI_UTILS.LSP. You'll need them esp. for DCL functions.
  259.  
  260. ------------------------------
  261.  
  262. [20.3] symbol->string
  263.  
  264.   The inverse function to (read) would be (symbol-name). The following
  265.   is the only general way, but there exist better special methods.
  266.  
  267.   ;;; SYMBOL-NAME - returns the name of a symbol as string
  268.   ;;; converts any valid lisp expression to its printed representation
  269.   ;;; (symbol-name a) -> "a",  (symbol-name '(0 1 2 a)) -> "(0 1 2 A)"
  270.   (defun SYMBOL-NAME (sym / f str tmp)
  271.     (setq tmp "$sym.tmp")      ;temp. filename, should be deleted
  272.     (setq f (open tmp "w"))(princ sym f) (close f)
  273.     (setq f (open tmp "r") str (read-line f) f (close f))
  274.     str)
  275.   
  276.   For plain symbols exists a better trick explained by Christoph
  277.   Candido at http://xarch.tu-graz.ac.at/autocad/news/symbol-string.txt
  278.   Vill/VLISP introduced a fast vl-symbol-name.
  279.   See also http://xarch.tu-graz.ac.at/autocad/stdlib/STDINIT.LSP
  280.  
  281. ------------------------------
  282.  
  283. [20.4] AutoCAD entity access [renamed SSAPPLY to SSMAP]
  284.  
  285.   See also http://xarch.tu-graz.ac.at/autocad/stdlib/STDENT.LSP
  286.  
  287.   ;;; returns the first group value of an entity.
  288.   ;;; like the wellknown (dxf) function but accepts all kinds of
  289.   ;;; entity representations (ename, entget list, entsel list)
  290.   ;;; NOTE: For getting 10 groups in LWPOLYLINE's not usable!
  291.   (defun GETVAL (grp ele)                 ;"dxf value" of any ent...
  292.     (cond ((= (type ele) 'ENAME)          ;ENAME
  293.             (cdr (assoc grp (entget ele))))
  294.           ((not ele) nil)                 ;empty value
  295.           ((not (listp ele)) nil)         ;invalid ele
  296.           ((= (type (car ele)) 'ENAME)    ;entsel-list
  297.             (cdr (assoc grp (entget (car ele)))))
  298.           (T (cdr (assoc grp ele)))))     ;entget-list
  299.  
  300.   ;;; Ex: (gettyp pline) => "POLYLINE"
  301.   (defun GETTYP (ele)                     ;return type
  302.     (getval 0 ele))
  303.  
  304.   ;;; assure ENAME
  305.   ;;; convert the entity to type ENAME (to write shorter code)
  306.   (defun ENTITY (ele)                     ;convert to element name
  307.     (cond                  ;accepts the following types:
  308.       ((= (type ele) 'ENAME) ele)             ; ENAME
  309.       ((not (listp ele)) nil)                 ; error: no list
  310.       ((= (type (car ele)) 'ENAME) (car ele)) ; entsel-list
  311.       ((cdr (assoc -1 ele)))                  ; entget-list or nil
  312.     )
  313.   )
  314.   ;and now just:
  315.   (defun getval (grp ele) (cdr (assoc grp (entget (entity ele)))))
  316.  
  317.   ;;; Ex: (istypep ele "TEXT")
  318.   ;;; is element a "SOLID"?
  319.   (defun istypep (ele typ)                   ;check type
  320.     (= (gettyp ele) typ))
  321.  
  322.   ;;; Ex: (istypep ele '("TEXT" "ATTDEF"))
  323.   ;;; is element a "TEXT" or a "ATTDEF"?
  324.   (defun ISTYPEP (ele typ) ;better implementation to accept lists too
  325.     (cond
  326.       ((listp typ)   (member (gettyp ele) typ)) ;bugfixed
  327.       ((stringp typ) (= (gettyp ele) typ))      ;assume typ uppercase
  328.       (T nil)))
  329.  
  330.   ;;; Ex: (getpt (entsel))  => ( 0.1 10.0 24)
  331.   (defun GETPT (ele)    ;return the startpoint of any element
  332.     (getval 10 ele))    ;group 10
  333.  
  334.   ;;; Ex: (getflag pline)  => 1 if closed
  335.   (defun GETFLAG (ele) (getval 70 ele)) ;same with the entity flag
  336.  
  337.   ;;; bitvalue val in flag of element set?
  338.   ;;; Ex: (flagsetp 1 pline)   => T if closed
  339.   ;;; Ex: (flagsetp 16 vertex) => T if spline control point
  340.   (defun FLAGSETP (val ele)
  341.     (bitsetp val (getflag ele)))
  342.  
  343.   ;;; Ex: (bitsetp 4 12) => T   ;bitvalue 4 (=2.Bit) in 12 (=4+8) is set
  344.   (defun BITSETP (val flag)
  345.     (= (logand val flag) val))
  346.  
  347.   ;;; convert selection set to list,
  348.   ;;; Note: it's also wise to use ai_ssget, because some ents could be
  349.   ;;;       on locked layers
  350.   ;;; Ex: (sslist (ai_ssget (ssget))) => list of selected unlocked ents
  351.   ;;; or  (mapcar 'entupd (sslist (ssget "X" '((8 . "TEMP")))))
  352.   ;;;       - regens all entities on layer TEMP
  353.   (defun SSLIST (ss / n lst)
  354.     (if (= (type ss) 'PICKSET)
  355.       (repeat (setq n (sslength ss))
  356.         (setq n (1- n)
  357.               lst (cons (ssname ss n) lst)))))
  358.  
  359.   ;;; apply a function to each ent in ss, in reversed order
  360.   ;;; Faster, but not so easy to understand. see [22.2]
  361.   ;;; [renamed from SSAPPLY to SSMAP to match the stdlib name]
  362.   ;;; Ex: (ssmap 'entupd (ssget))   ; regenerate only some entities
  363.   (defun SSMAP (fun ss / n)
  364.     (if (= 'PICKSET (type ss))
  365.       (repeat (setq n (sslength ss))
  366.         (apply fun (list (ssname ss (setq n (1- n))))))))
  367.  
  368. ------------------------------
  369.  
  370. Subject: [21] Sample Lisp Programs:
  371.  
  372. [21.1] Globally change texts, polylines, layer utils, datestamp
  373.  
  374.   For globally changing text attributes use CHTEXT.LSP in your
  375.   sample directory.
  376.  
  377.   For globally changing polyline attributes, freeze layers by pick
  378.   and other similar tasks search for free lisp tools at any AutoLISP
  379.   site. See "[1]" and some code at "[22]","[23]","[24]"
  380.  
  381.   For putting a datestamp and others onto your plots automatically
  382.   first check out if your plotter supports HPGL/2. Then use the
  383.   internal HPGL/2 driver and configure the datestamp in HPCONFIG.
  384.  
  385.   DATESTAMP.LSP: Change the plot header attributes by yourself
  386.   as in [22.2]. A profi plotstamp routine is here:
  387.   http://ourworld.compuserve.com/homepages/tonyt/plotstmp.htm
  388.  
  389. ------------------------------
  390.  
  391. [21.2] Plot dialog from within Lisp. Using DDE or ActiveX or initdia
  392.  
  393.   (initdia)(command "_PLOT")
  394.  
  395.   Calling the PLOT dialogbox from AutoLISP *before R14* was possible
  396.   only under Windows i.e. with LISPPLOT by Mike Dickason. This fed
  397.   the keyboard buffer with keystrokes.
  398.     http://www.cadalog.com/ files/lispd-l/lspplw.zip
  399.   or also: ftp://ftp.mcwi.com/pub/mcwi/lisp/winplt.lsp
  400.   Otherwise create a script and call this at the end of your lisp, but
  401.   this will not show up the dialogbox.
  402.  
  403.   Xiang Zhu: You could have used "DDELISP" under Windows. [shortened]
  404.   ;;; [fixed for all releases]
  405.   (defun DDECMD (str / tmp acadver ddestr)
  406.     (if (not (boundp 'initiate))
  407.       (cond
  408.         ((= 14 (setq acadver (atoi (getvar "ACADVER"))))
  409.          (setq ddestr "AutoCAD.R14.DDE") (arxload "ddelisp"))
  410.         ((= 13 acadver)
  411.          (setq ddestr "autocad.r13.dde") (xload "ddelisp"))
  412.         ((= 12 acadver)
  413.          (setq ddestr "autocad.dde") (xload "ddelisp"))
  414.         (T (princ "DDE not supported")(exit))))
  415.       (if (not (zerop (setq tmp (initiate ddestr "system"))))
  416.         (progn
  417.           (execute tmp (strcat "[" str "]"))
  418.           (terminate tmp)
  419.           str)))
  420.   (ddecmd "_plot ") ; return would be "^13"
  421.  
  422.   Beware that Acad accepts only DDE commands if the command line is
  423.   active, that means no dialogbox must be open.
  424.  
  425.   With vlisp/ViLL ActiveX methods can be used to plot, but the
  426.   dialog can not be called:
  427.  
  428.   ;;; vlisp syntax:
  429.   (setq vlax:ActiveDocument (vla-get-ActiveDocument 
  430.     (vlax-get-Acad-Object)))
  431.   (setq plt (vla-get-plot vlax:ActiveDocument))   ;=> plot object
  432.   (vla-PlotWindow plt pt1 pt2)                    ;WCS pts
  433.   (vla-PlotPreview plt 1)                         ;0; partial, 1: full
  434.   (vla-PlotToDevice plt "Default System Printer") ;if it exists
  435.  
  436.   With R14 INITDIA was introduced, which can be applied to most but not
  437.   all dialogs:
  438.     (initdia)(command "_PLOT")
  439.  
  440.   With A2000 use OLE (VLA- methods) instead of DDE. DDE support is 
  441.   discontinued by Microsoft. OLE provides a better object-oriented 
  442.   interface.
  443.  
  444. ------------------------------
  445.  
  446. [21.3] (entmod) and (entmake) Layers, without (command "_LAYER"...)
  447.  
  448.   ENTMOD a layer
  449.   I try to change a layer property without calling COMMAND function
  450.   inside a lisp routine.
  451.  
  452.   Since R13, using the following lisp
  453.     (setq tbl_lst (entget (tblobjname "LAYER" "ANY_LAYER"))
  454.           clr_grp (assoc 62 tbl_lst)
  455.     )
  456.     (entmod (subst (cons 62 (- (cdr clr_grp))) clr_grp tbl_lst))
  457.   you can toggle "ANY_LAYER" On or Off, even it is the current layer.
  458.  
  459.   But AutoCAD doesn't know a table entry has been changed until you
  460.   click the Layer Control on the toolbar or something similar.
  461.   Besides, you can issue 'DDLMODES to see On/OFf property of
  462.   "ANY_LAYER" changed.
  463.   Doing the same way to freeze a layer, you will still see entities on
  464.   that layer shown on screen, but you can not select them, until you do
  465.   something related to layer settings, and AutoCAD will hide those
  466.   entities.
  467.  
  468.   ENTMAKE a layer
  469.   You must get your pattern with entget, using the table object name as
  470.   argument. This table object name can be retrieved with the TBLOBJNAME
  471.   function:
  472.   (entget (tblobjname "LAYER" "Any Layer Name")) ; R2000 can have spaces!
  473.  
  474.   ;;; This routine will create a layer with any name you type:
  475.   (defun C:MLAY ()    ; by Reinaldo Togores <rtogores@mundivia.es>
  476.     (setq laynam (getstring "\nLayer name: "))
  477.       (entmake
  478.         (list
  479.           '(0 . "LAYER")
  480.           '(5 . "28")
  481.           '(100 . "AcDbSymbolTableRecord")
  482.           '(100 . "AcDbLayerTableRecord")
  483.           (cons 2 laynam)
  484.           '(70 . 64)
  485.           '(62 . 7)
  486.           '(6 . "CONTINUOUS")
  487.       )))
  488.  
  489. ------------------------------
  490.  
  491. [21.4] How to select multiple files in Lisp? (as in FILES - Unlock) [new]
  492.  
  493.   * DOSLIB v4.3 from McNeel contains dos_getfilem,
  494.     http://www.mcneel.com/products.htm#Utilities
  495.   * STDLIB contains std-getfilem
  496.     http://xarch.tu-graz.ac.at/autocad/stdlib/GETFILEM.LSP
  497.   * At http://xarch.tu-graz.ac.at/autocad/progs/MGETFILD.ZIP
  498.     is another lisp helper routine to select multiple files with DCL.
  499.     You will also need VLISP, DOSLIB or the STDLIB to access the
  500.     directory functions. Another lisp version is at
  501.     http://xarch.tu-graz.ac.at/autocad/stdlib/Reini_MFD.LSP
  502.  
  503. ------------------------------
  504.  
  505. [21.5] Replace multiple blocks
  506.  
  507.   A search at the lisp archives yielded those hits:
  508.    Cadalyst: http://www.cadonline.com/search.phtml
  509.   => 97code.htm and a question for your username which can be obtained
  510.    free and automatically
  511.   or xarch: http://xarch.tu-graz.ac.at/autocad/code and search for
  512.    "BLOCK;REPLACE"
  513.   => http://xarch.tu-graz.ac.at/autocad/code/cadalyst/94-02/replace.lsp
  514.   also at the Cadalog:
  515.    http://www.cadalog.com/ OpenSource Freeware Keyword: "Block Replace"
  516.   => replace.zip (this one is the best)
  517.  
  518. ------------------------------
  519.  
  520. [21.6] (vports), VIEWPORT entity, pixel conversion
  521.  
  522.   VIEWPORT entity:
  523.   The answer to "I can do an (entget) on a VIEWPORT and get its lower
  524.   left (DXF group 10) and upper right (DXF group 11) corner.  But it
  525.   appears that these coordinates are in the paper space system.  What
  526.   I'm interested in finding out is what portion of the "real" drawing
  527.   (the model space drawing) are currently shown in that viewport."
  528.   is at http://xarch.tu-graz.ac.at/autocad/news/vports.lsp
  529.  
  530.   http://www.ez-sys.net/~coopfra/lisp.htm#view has also some tricks.
  531.  
  532.   How to change viewports in AutoLISP?
  533.   with (setvar "CVPORT" vport-id)
  534.   see http://xarch.tu-graz.ac.at/autocad/news/change_vports.html
  535.  
  536.   With the following functions you convert pixel<->drawing units:
  537.  
  538.   ;;; Conversion pixel to drawing units
  539.   (defun PIX2UNITS (pix)
  540.     (* pix (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))))
  541.  
  542.   ;;; Conversion drawing units to pixel
  543.   (defun UNITS2PIX (units)
  544.     (* units (/ (cadr (getvar "SCREENSIZE"))(getvar "VIEWSIZE"))))
  545.  
  546.   Note also the "Pixel Off by One" Errors in AutoCAD, written by Vibrant
  547.   http://xarch.tu-graz.ac.at/autocad/news/pixel-off-by-one-error.txt
  548.  
  549. ------------------------------
  550.  
  551. [21.7] Select all visible objects: zoom coordinates
  552.  
  553.   Beware that with (ssget) you will only get visible objects, because
  554.   all interface functions (entsel,ssget,osnap) work with pixel, only
  555.   (ssget "X") will select not visible objects.
  556.  
  557.   ;;; returns a list of the actual viewport corners in WCS
  558.   (defun ZOOMPTS ( / ctr h screen ratio size size_2)
  559.     (setq ctr (xy-of (getvar "VIEWCTR")) ;3D -> 2D
  560.           h   (getvar "VIEWSIZE")        ;real
  561.           screen (getvar "SCREENSIZE")   ;2D: Pixel x,y
  562.           ratio (/ (float (car screen))  ;aspect ratio
  563.                    (cadr screen))
  564.           size (list (* h ratio) h)      ;screensize in coords
  565.           size_2 (mapcar '/ size '(2.0 2.0)))
  566.       (list (mapcar '- ctr size_2)
  567.             (mapcar '+ ctr size_2)))
  568.   (defun XY-OF (pt) (list (car pt)(cadr pt)))   ;assure 2D coords
  569.  
  570.   Note: The points returned are in WCS but this is ok, because the
  571.     "CP" "WP" and "P" options of ssget expect WCS points.
  572.     "W" and "C" require UCS points - why the difference I don't know.
  573.  
  574.   ;;; one way to define this function
  575.   (defun SSALL-VISIBLE (/ l)
  576.     (ssget "C" (car (setq l (maptrans0-1 (zoompts)))) (cadr l)))
  577.   ;;; or another
  578.   (defun SSALL-VISIBLE-1 ()      ;combine "C" and (p1 p2) to one list
  579.     (apply 'ssget (append '("C") (maptrans0-1 (zoompts)))))
  580.  
  581.   ;;; map some pts from WCS to UCS, easier with just one argument
  582.   (defun MAPTRANS0-1 (pts) (mapcar '(lambda (pt)(trans pt 0 1)) pts))
  583.  
  584. ------------------------------
  585.  
  586. Subject: [21.8] How to write XYZ data of selected objects to a file?
  587.  
  588.   ;;; CDF - comma delimited string
  589.   (defun CDF-POINT (pt)
  590.     (strcat (car pt) ", " (cadr pt) ", " (caddr pt)))
  591.   ;;; SDF - space delimited, may easier be read back in to AutoCAD
  592.   (defun SDF-POINT (pt)
  593.     (strcat (car pt) " " (cadr pt) " " (caddr pt)))
  594.   ;;; convert this SDF format back to a point with
  595.   (defun STR->POINT (s)
  596.     (eval (read (strcat "(" s ")"))))
  597.  
  598.   ;;; Write a XYZ file of all selected objects (SDF see below)
  599.   (defun C:XYZ (/ ss fname f)
  600.     (if (and (setq ss (ssget))
  601.           (setq fname (getfiled "Write XYZ to file"
  602.                   (strcat (getvar "DWGNAME") ".XYZ") "XYZ" 7))
  603.           (setq f (open fname "w")))
  604.       (foreach ele (sslist ss)          ; -> [20.4]
  605.         (foreach pt (getpts ele)        ; -> [23.1]
  606.           (write-line (cdf-point pt) f))))
  607.     (if f (close f)))
  608.  
  609.   ;;; => <fname>.xyz
  610.   ;;; 0.45, 12.3, -34.0
  611.  
  612.   For a ASC file (SDF-format) simply change all XYZ to ASC
  613.   and cdf-point to sdf-point above.
  614.  
  615.   For the other way 'round, creating PLINES from a ascii x,y file
  616.   best convert the file to a script like:
  617.   PLINE
  618.   300.2,10
  619.   350.4,10.4
  620.  
  621. ------------------------------
  622.  
  623. Subject: [22] Block Attributes
  624.  
  625. [22.1] How to access block attributes?
  626.  
  627.   Check all subentities after the INSERT until the attribute is found.
  628.   See http://xarch.tu-graz.ac.at/autocad/stdlib/STDENT.LSP
  629.  
  630.   ;;; returns entget-list of attribute attname (STRING) in element ele
  631.   ;;; or nil if not found
  632.   (defun ATTELE (ele attname / rslt)
  633.     (if (and (istypep ele "INSERT")
  634.              (= (getval 66 ele) 1))
  635.       (progn
  636.         (setq ele (entnext (entity ele)))
  637.         (while (istypep ele "ATTRIB")
  638.           (if (= (strcase (getval 2 ele)) (strcase attname))
  639.             (setq rslt (entget ele) ele nil)      ;break the loop
  640.             (setq ele (entnext ele))))))
  641.     rslt
  642.   )
  643.  
  644.   ;;;Example:
  645.   (attele (entsel) "TEST")   ; returns entget-list of
  646.                              ; attribute "TEST" if the block has it
  647.  
  648.   BTW: Even trickier functions to get entities DXF group codes are
  649.        GET and EDLGETENT by Vladimir Nesterowsky.
  650.   ;;;Sample calls:
  651.   ;;; return list of 2,1 and -1 group values
  652.   (defun GET-ATTRIBS-LOOK-UP (block-ename)
  653.     (get '(2 1 -1) (cdr (edlgetent block-ename))))
  654.  
  655.   (defun ALL-VERTICES-AND-BULGES (pline-ename)
  656.     (get '(10 42)  (cdr (edlgetent pline-ename))))
  657.  
  658.   available at http://members.tripod.com/~vnestr/
  659.  
  660. ------------------------------
  661.  
  662. [22.2] How to MODIFY block attributes? DATESTAMP.LSP
  663.  
  664.   For a very simple DATESTAMP.LSP simply entmod the entget-list 
  665.   of the DATE attribute in your plotstamp block, retrieved from 
  666.   (attele) as above.
  667.  
  668.   ;;; change the attribute value of INSERT ele to new (group 1)
  669.   (defun ATTCHG (ele attname new / b)
  670.     (if (setq b (attele ele attname))
  671.       (entmod (subst (cons 1 new) (getval 1 b) b))))
  672.  
  673.   ;;; Change all DATESTAMP attributes in all inserted PLOT* blocks
  674.   (defun C:DATESTAMP ()
  675.     (ssmap            ;fixed by Alan Williams, wrong arg order
  676.      '(lambda (ele)
  677.         (attchg ele "DATESTAMP" (today))
  678.         (entupd ele)
  679.       )
  680.       (ssget "X" '((0 . "INSERT")(2 . "PLOT*")))))
  681.   ;;;return todays date, could be a DIESEL or this string conversion
  682.   (defun TODAY (/ s)
  683.     (setq s (rtos (getvar "CDATE") 2))  ;gets the julian date
  684.     (strcat (substr s 5 2) "-" (substr s 7 2)"-"(substr s 3 2)))
  685.  
  686.   Automatic datestamps are normally done with either RTEXT 
  687.   (bonus/express tools) or HPCONFIG with a HPGL/2 plotter. (<a2000i)
  688.  
  689. ------------------------------
  690.  
  691. [22.3] How to UPDATE block attributes?
  692.  
  693.   There exists a support/ATTREDEF.LSP to update attribute properties
  694.   (position, layer, ...) for already inserted blocks.
  695.  
  696.   On complex entities you must (entupd) the header entity, to see
  697.   the update on the screen (forces an element REGEN).
  698.  
  699.   ;;; Example:
  700.   (setq s (getstring "Change Attribute to: "))
  701.   (attchg (attele (setq b (entsel "of block: ")) s)))
  702.   (entupd (car b))        ; the block, not the attribute
  703.  
  704.   ;;; some more helper funcs to get the main entity of any attribute
  705.   ;;; or vertex
  706.   (defun MAIN-ENTITY (ele)
  707.     (setq b (entity b))   ;force ENAME
  708.     (while (istypep b '("ATTRIB" "ATTDEF" "VERTEX"))
  709.       (setq b (entnext b)))               ;loop until no more sub-ents
  710.     (if (istypep b '("SEQEND" "ENDBLK"))
  711.       (getval -2 b)                       ;complex entity -> header
  712.       b                                   ;normal entity
  713.     )
  714.   )
  715.  
  716. ------------------------------
  717.  
  718. [22.4] How to ENTMAKE a Block Complex Entity in AutoLISP
  719.  
  720.    See http://xarch.tu-graz.ac.at/autocad/stdlib/ENTMAKE.LSP or 
  721.    http://www.autodesk.com/support/techdocs/td30/td301515.htm (broken)
  722.    There is an example how to use multiple calls to (entmake) to create
  723.    the block header, the entities, closes the block and finally
  724.    (entmake) the INSERT.
  725.      For anonymous blocks beware that only
  726.    (setq bn (entmake '((0 . "ENDBLK")))) returns the blockname for
  727.    (entmake (list '(0 . "INSERT")'(70 . 1)(cons 2 bn) ...))
  728.  
  729. ------------------------------
  730.  
  731. Subject: [23] Polylines
  732.  
  733.   Since R14 LWPOLYLINE's store the vertices in one entity as multiple 10
  734.   groups. So (assoc) will not work.
  735.  
  736. [23.1] How to access polyline VERTICES?  [updated for R14]
  737.  
  738.   A polyline VERTEX is a subentity of a POLYLINE (same as an ATTRIBUTE
  739.   is a subentity of an INSERT element or a ATTDEF of a BLOCK).
  740.   Therefore the same functions as in [22.1]-[22.3] can be used.
  741.  
  742.   ;;; return only some assoc values in the list (for LWPOLYLINE)
  743.   (defun GROUP-ONLY (grp lst)
  744.     (mapcar 'cdr (remove-if-not '(lambda(pair)(= grp (car pair))) lst)))
  745.  
  746.   ;;; return the vertex list of a polyline or of any other element
  747.   ;;; Note that with edlgetent mentioned in [22.1] it's a one-liner
  748.   (defun GETPTS (ele / pts)
  749.     (setq ele (entity ele))        ;force type ENAME
  750.     (cond
  751.       ((istypep ele "POLYLINE")
  752.         (while (istypep (setq ele (entnext ele)) "VERTEX")
  753.           ;; omit fit and spline points  (conservative style)
  754.           (if (not (or (flagsetp 1 ele) (flagsetp 8 ele))) ;bugfix!
  755.             (setq pts (cons (trans (getpt ele) ele 0) pts)))
  756.           (reverse pts)))
  757.       ;; Special case: you have to map it, assoc finds only the first.
  758.       ;; Fix a LWPOLYLINE bug in R14: internally stored as 2d point,
  759.       ;;   (entget) returns fantasy z-values.
  760.       ((istypep ele "LWPOLYLINE")
  761.         (mapcar '(lambda(pt)(trans (list (car pt)(cadr pt) 0.0) ele 0))
  762.                  (group-only 10 (entget ele))))
  763.       ;; insert here possible other types, such as
  764.       ((istypep ele '("TEXT" "CIRCLE")) (list (getpt ele)))
  765.       ;; more like this (serge's style)
  766.       (T (apply 'append (mapcar
  767.         '(lambda (n / p) (if (setq p (getval n ele)) (list p)))
  768.         '(10 11 12 13)))
  769.       )
  770.       ;; or like this (conservative style)
  771.       ;;(T (foreach n '(10 11 12 13)
  772.       ;;     (if (setq p (getval n ele)) (setq pts (cons p pts))))
  773.       ;;  pts
  774.       ;;)
  775.     )
  776.   )
  777.  
  778.   Suggestions by Vladimir Nesteroswky for a different vertex structure:
  779.   (defun VERTICES-AND-BULGES (pline-ename)
  780.     (mapcar 'cdr
  781.       (remove-if-not '(lambda (ele) (bitsetp 9 x))
  782.         (get '(70 10 42) (cdr (edlgetent pline-ename))
  783.   => list of (10 42) pairs of the pline
  784.  
  785.   See also [23.5] for a different edge structure (segments) of plines.
  786.  
  787. ------------------------------
  788.  
  789. [23.2] How to JOIN multiple lines to polylines?
  790.  
  791.   Simply try to join each element with all selected, but beware that
  792.   an entity already joined cannot be entget'ed anymore, because it's
  793.   deleted.
  794.  
  795.   ;;; This sample converts all selected elements to polylines and
  796.   ;;;  tries to join as much as possible.
  797.   (defun C:JOINPOLY (/ ele ss)
  798.     (foreach ele (sslist (setq ss (ssget)))     ;better process lists
  799.       (if (entget ele)                          ;not already joined
  800.         (cond                                   ;(then it would be nil)
  801.           ((istypep ele '("ARC" "LINE"))
  802.             ;; in fact you should check Z of lines and UCS here too
  803.             (command "_PEDIT" ele "_Y" "_J" ss "" ""); convert and JOIN
  804.           )
  805.           ((and (istypep ele '("POLYLINE" "LWPOLYLINE")) ;bugfix
  806.                 (not (flagsetp 1 ele))          ;not closed
  807.                 (< (rem (getflag ele) 128) 8))  ;ignore meshes and such
  808.             (command "_PEDIT" ele "_J" ss "" "");ucs check omitted
  809.           )
  810.         )
  811.       )
  812.     )
  813.   )
  814.  
  815. ------------------------------
  816.  
  817. [23.3] Change WIDTH of multiple polylines
  818.  
  819.   With the help of the above defined helper function it's a short one:
  820.  
  821.   (defun C:POLYWID (/ wid ele)
  822.     (initget 5)(setq wid (getdist "New Polyline Width: ")) ;not negative
  823.     (foreach ele (sslist (ssget '((0 . "*POLYLINE"))))     ;only PLINES
  824.       (command "_PEDIT" ele "_W" wid "")))
  825.  
  826. ------------------------------
  827.  
  828. [23.4] Create a polyline or spline: with (ENTMAKE) or (COMMAND)
  829.  
  830.   1. You can create a script-file with a LISP-program and then run it.
  831.   It seems to be the simpliest way, but I/O errors may occur when
  832.   reading/writing the script. If your soft is commercial, it must handle
  833.   such errors.
  834.  
  835.   2. The second way is to create the entities list and use ENTMAKE.
  836.   Advantage: fast, in WCS, independent of actual osnaps.
  837.   See http://xarch.tu-graz.ac.at/autocad/stdlib/ENTMAKE.LSP
  838.  
  839.   3. The third solution is based on command and mapcar. It works with
  840.   Polylines, Splines or Lines. Disadvantage: UCS, Osnaps
  841.  
  842.   ;;; Draws a POLYLINE entity from a list of points (same with SPLINE,
  843.   ;;;  or LINE), on the actual UCS, with actual OSNAP settings
  844.   (defun DRAW-PLINE (pts)
  845.     (command "_PLINE")
  846.     (mapcar 'command pts)
  847.     (command ""))
  848.   (defun DRAW-SPLINE (pts)
  849.     (command "_SPLINE")
  850.     (mapcar 'command pts)   ; the pts must be the fitpoints then
  851.     (command "" "" ""))
  852.  
  853. ------------------------------
  854.  
  855. [23.5] How to calculate the LENGTH of polylines?
  856.  
  857.   There are two ways:
  858.   1. the obvious, using the AREA command which is quite "noisy"
  859.     (prints the result), but works even with splines.
  860.  
  861.   ;;; add up the LENGTH of all selected objects, NOISY, you can do the
  862.   ;;; same with AREAs: simply change the last line to (getvar "AREA")
  863.   (defun C:LEN-OF ()
  864.     (command "_AREA" "_A" "_E")           ;add up objects (for R12+13)
  865.     (ssmap 'command (ssget))            ;pass all elements to AutoCAD
  866.     (command "" "")                       ;two returns
  867.     (getvar "PERIMETER"))                 ;this is the length
  868.  
  869.   2. Doing some math, but only for simple entities. Here it is best to
  870.     define some helper functions again. This is also an introduction for
  871.     the next chapter [24], some bulge trigonometry for curved segments.
  872.  
  873.   ;;; calculates length of a pline, quiet
  874.   (defun POLY-LENGTH (poly / seg)
  875.     (apply '+             ; the sum of all single segment lengths
  876.       (mapcar
  877.        '(lambda (seg)                         ;length of one segment
  878.           (if (zerop (car seg))               ;is it straight?
  879.             (distance (cadr seg) (caddr seg)) ; line segment or
  880.             (abs (arclen seg))))              ; curved: -> [24]
  881.         (pline-segs poly))))        ;segment list (bulge p1 p2)
  882.  
  883.   ;;; returns all group codes of the complex element
  884.   ;;; (vertices, attributes) as list, similar to (edlgetent)
  885.   (defun CPLX-LIST (grp ele / lst)
  886.     (if (= 1 (getval 66 ele))
  887.       (progn (setq ele (entnext (entity ele)))
  888.         (while (and ele (not (istypep ele "SEQEND")))
  889.           (setq lst (cons (getval grp ele) lst)
  890.             ele (entnext ele)))
  891.         (reverse lst))))
  892.  
  893.   ;;; Creates a segment list for the polyline pname
  894.   ;;;   as a list of '(bulge p1 p2). A straight line has bulge 0.0
  895.   ;;; Compute pts in ECS of pname. Accepts LWPOLYLINE's
  896.   (defun PLINE-SEGS (pname / pts segs)
  897.     (setq segs
  898.       (mapcar 'list
  899.         (if (istypep pname "LWPOLYLINE")
  900.           (group-only 42 (entget pname))
  901.           (cplx-list 42 pname))
  902.         (setq pts (getpts pname))       ; ->[23.1]
  903.         (rot1 pts)))                    ; ->[20.1]
  904.     (if (flagsetp 1 pname)
  905.       segs        ;closed
  906.       (butlast segs)))     ;open: without the last segment, ->[20.1]
  907.  
  908.   ;;; Example:   (a bit optimized for brevity :)
  909.   ;;; Add up all the lengths of all selected polylines, quiet
  910.   ;;; To accept also other entities, add those to pline-segs
  911.   (defun C:POLYLEN ()
  912.     (apply '+ (ssmap 'poly-length (ssget '((0 . "*POLYLINE"))))))
  913.  
  914. For the sum of areas use either the noisy AREA command or implement
  915. Heron's formula for polygon areas (just for simple closed polygons).
  916.  
  917. ------------------------------
  918.  
  919. [23.6] How to REVERT a polyline direction?
  920.  
  921.   Sergei Komarov submitted a REVPOLY.LSP which takes care of
  922.   bulges and widths too.
  923.   http://xarch.tu-graz.ac.at/autocad/news/lisp_progs/revpoly.lsp
  924.  
  925.   A short stdlib version is this:
  926.   ;;; ignoring any width information
  927.   (defun POLY-REVERSE (segs)
  928.     (reverse (mapcar '(lambda (seg) (std-make-seg (std-seg-p2 seg)
  929.                               (std-seg-p1 seg)
  930.                                (- (std-seg-bulge-num seg))))
  931.            segs)))
  932.   (defun C:POLYREV (/ ele)
  933.     (std-require "ENTMAKE")
  934.     (if (setq ele (car (entsel "\nRevert Poly: ")))
  935.       (std-entmake-pline (entget ele '("*")) ; keep EED information
  936.                      (poly-reverse (std-pline-segs ele)))))
  937.  
  938. ------------------------------
  939.  
  940. [23.7] How to get the CENTER of a polyline?
  941.  
  942. The centroid of SOLID's has to be extracted with MASSPROP. 
  943. You can let it write to a file and analyse this then.
  944. The centroid of polylines is different to the mean vector. 
  945. The 2D geometric mean of some pts is simply:
  946.  
  947.   (setq n (float (length pts)))
  948.   (list (/ (apply '+ (mapcar 'car pts)) n)
  949.         (/ (apply '+ (mapcar 'cadr pts)) n))
  950.  
  951. The true centriod is more difficult. The stdlib version is at
  952. http://xarch.tu-graz.ac.at/autocad/stdlib/STDPOINT.LSP STD-CENTROID-2D
  953. In the stdlib.arx or at www.manusoft.com (under freebies) are also a 
  954. better massprop lisp function for solids. Then you do 
  955. (command "_REGION" ele)...(massprop entlast)...(command "_UNDO" 1)
  956. For VLA there's also a massprop property for Acis objects.
  957.  
  958. ------------------------------
  959.  
  960. Subject: [24] Circle/Arc Geometry: BULGE conversion, some trigonometry
  961.  
  962.   What is the *BULGE* in a polyline?
  963.  
  964.   The bulge is the tangent of one forth of the included angle of a
  965.   curved segment. A bulge 0.0 means a straight segment.
  966.   Together with the start- and endpoint it is sufficient information to
  967.   quickly calculate all other required information of a curved segment.
  968.   A negative bulge is a rotation in clockwise direction ("mathematically 
  969.   negative").
  970.  
  971.     arclength = radius*angle
  972.     bulge     = tan( ang/4 )            (CCW: +, CW: -)
  973.     angle     = 4*atan( bulge )
  974.     bulge     = ( 2*altitude ) / chord  (CCW: +, CW: -)
  975.  
  976.   See also http://www.autodesk.com/support/techdocs/fax700/fax797.htm
  977.   for a sample program or the book "Maximizing AutoLISP" [2]
  978.   (Note: The R10/11 book -Vol II- contains a wrong bulge formula.)
  979.  
  980.   ;;; converts a bulged segment (bulge pt1 pt2) of a polyline
  981.   ;;;   to a circle (ctr rad), the start- and endpoints are known
  982.   ;;;   therefore the angles too: (angle ctr pt1)(angle ctr pt2)
  983.   ;;; returns nil on a straight segment!
  984.   ;;; (bugfixed version. Thanks to Sergei Komarov)
  985.   (defun SEG2CIR (seg / bulge p1 p2 cot x y rad dummy)
  986.     (if (zerop (car seg))  ;straight line => invalid circle
  987.       nil
  988.       (setq bulge (car seg) p1 (cadr seg) p2 (caddr seg)
  989.         cot (* 0.5 (- (/ 1.0 bulge) bulge))
  990.         x (/ (- (+ (car  p1) (car  p2))
  991.                 (* (- (cadr p2) (cadr p1)) cot)) 2.0)
  992.         y (/ (+ (+ (cadr p1) (cadr p2))
  993.                 (* (- (car  p2) (car  p1)) cot)) 2.0)
  994.         rad (distance (list (car p1) (cadr p1)) (list x y))
  995.         dummy (list (list x y) rad))))   ; return this, I hate progn's
  996.  
  997.   ;;; inverse conversion
  998.   ;;; calculates segment (bulge p1 p2) of arc
  999.   ;;;   with given circle (ctr rad), start-angle, end-angle
  1000.   (defun ARC2SEG (cir ang1 ang2 / p1 p2)
  1001.     (setq p1 (polar (car cir) ang1 (cadr cir))
  1002.           p2 (polar (car cir) ang2 (cadr cir)))
  1003.     (list (arc2bul p1 p2 cir) p1 p2))
  1004.  
  1005.   ;;; calculates bulge of arc given the arc points and the
  1006.   ;;;   circle (ctr rad) [fixed by Serge Pashkov]
  1007.   (defun ARC2BUL (p1 p2 cir / ang)
  1008.     (setq ang (- (angle (car cir) p2) (angle (car cir) p1)))
  1009.     (if (minusp ang) (setq ang (+ (* 2.0 pi) ang)))
  1010.     (tan (/ ang 4.0)))
  1011.  
  1012.   ;;; returns angle of arc (bulge)
  1013.   ;;; The seg format is (bulge p1 p2)
  1014.   (defun BUL2ANG (seg / ctr)
  1015.     (- (angle (setq ctr (car (seg2cir seg))) (cadr seg))
  1016.        (angle ctr (caddr seg))))
  1017.  
  1018.   ;;; calculates angle of arc given the chord distance and radius
  1019.   (defun ARC2ANG (chord rad)
  1020.     (* 2.0 (atan
  1021.              (/ chord 2.0
  1022.                (sqrt (- (expt rad 2)
  1023.                         (expt (/ chord 2.0) 2)
  1024.   ) )      ) ) )     )  ;another way in the paren's world
  1025.  
  1026.   ;;; length of arc   = radius*angle,
  1027.   ;;; Note: +/-, you'll need (abs (arclen seg)) for the distance
  1028.   (defun ARCLEN (seg)
  1029.     (* (cadr (seg2cir seg))                 ;radius
  1030.        4.0 (atan (car seg))))               ;angle = 4*atan(bulge)
  1031.  
  1032.   (setq *INFINITY* 1.7e308)                 ; largest double
  1033.   (defun TAN (z / cosz) ; [fixed]
  1034.     (if (zerop (setq cosz (cos z))) *INFINITY*
  1035.       (/ (sin z) cosz)))
  1036.   (defun DTR (ang)(* pi (/ ang 180.0)))     ;degree to radian
  1037.   (defun RTD (ang)(/ (* ang 180.0) pi))     ;radian to degree
  1038.  
  1039. ------------------------------
  1040.  
  1041. Subject: [25] DCL: listboxes with tabs or monotext font
  1042.  
  1043.   Under Windows it's difficult to layout texts because of non-monospaced
  1044.   fonts. Try it with the tabs attribute in the list_box tile,
  1045.   such as:
  1046.     tabs = "0 20 40";
  1047.   and (set_tile "listbox" "Layer:\t0\twhite")
  1048.   try the following to use monospaced characters:
  1049.  
  1050.       : list_box {
  1051.           label = "Drawing";
  1052.           key = "dwglist";
  1053.           width = 50;
  1054.           fixed_width_font = true;   // <- monotext
  1055.       }
  1056.  
  1057.   Also might want to look at the detab routine (TAB -> Spaces) at
  1058.   http://xarch.tu-graz.ac.at/autocad/news/detab.lsp or STD-DETAB in
  1059.   http://xarch.tu-graz.ac.at/autocad/stdlib/STDSTR.LSP
  1060.  
  1061. ------------------------------
  1062.  
  1063. Subject: [26] EED Extended Entity Data: Select, Get and Store
  1064.  
  1065. [26.1] Select objects on their EED with (ssget "X")
  1066.  
  1067.   ;;; defines your appname header and delimiter (4 char regapp name
  1068.   ;;; according AAIG, AutoDESK Application Interoperation Guidelines)
  1069.   (setq appname "HUBU-")
  1070.   ;;; defines * for all sub types
  1071.   (setq allappnames (strcat appname "*"))
  1072.   ;;; eg: HUBU-LIST1, HUBU-LIST2
  1073.  
  1074.   ;;; here is how to get the first eed list from one element
  1075.   (defun get-eed-1st (ele)
  1076.     (cdadr (assoc -3 (entget (entity ele) (list allappnames)))))
  1077.  
  1078.   ;;; this gets all elements of appnames typ (wildcards allowed)
  1079.   (defun ssget-app (typ)  ;fast
  1080.     (ssget "X" (list (list -3 (list typ))))
  1081.  
  1082.   ;;; this gets only your elements
  1083.   (defun ssget-hubu (typ)  ;fast
  1084.     (ssget "X" (list (list -3 (list (strcat appname typ)))))
  1085.  
  1086.   (ssget-hubu "*")  ; will get all your elements
  1087.  
  1088. ------------------------------
  1089.  
  1090. [26.2] Get EED from an object
  1091.  
  1092.   Check any XDATA with:   (entget (car (entsel)) '("*"))
  1093.  
  1094.   ;;; GETXDATA - get all XDATA lists from an element
  1095.   ;;; i.e with XDATA:
  1096.   ;;; (-3  ("HUBU-1" (1000 ."ASSHATCH")(1002 ."{")
  1097.   ;;;                (1070 . 1)(1002 ."}")))
  1098.   ;;; =>(("HUBU-1" (1000 ."ASSHATCH")(1002 ."{")(1070 . 1)(1002 ."}")))
  1099.   (defun getxdata (e apnlst)
  1100.     (cdr (assoc -3 (entget e apnlst))))
  1101.  
  1102.   ;;; GETXDATA-ALL - all lists without the regapp name
  1103.   ;;; => ((1000 ."ASSHATCH")(1002 ."{")(1070 . 1)(1002 ."}"))
  1104.   (defun getxdata-all (e apnlst)
  1105.     (apply 'append (mapcar 'cdr (getxdata e apnlst))))
  1106.  
  1107.   The regapp name is stripped here, because it's only used for fast
  1108.   ssget access. The different apps are divided by different
  1109.   (1000 . name) groups as it's used by AutoDESK.
  1110.  
  1111.   For storing XDATA in an element see XDATA.LSP or XED.LSP though those
  1112.   examples are a bit disturbing.
  1113.  
  1114.   For advanced EED tricks, esp. converting the "{" "}" ADS resbuf style
  1115.   to Lisp lists and back, see
  1116.   http://xarch.tu-graz.ac.at/autocad/news/eed_retrieval.txt
  1117.  
  1118. ------------------------------
  1119.  
  1120. Subject: [27] How to break a command in Lisp?
  1121.  
  1122.   Also: "How do I press Break in AutoLISP?"
  1123.  
  1124.   (command) without parameters works just like hitting Ctrl-C under
  1125.   DOS or Esc under Windows at the command prompt. But it does not
  1126.   mimic Esc in a dialog box. And it does not work within
  1127.   SCRIPTS. (command nil) is the same as (command).
  1128.  
  1129.   (command) breaks only the command functions, e.g. if you use the
  1130.   command "DIM" inside AutoLISP, you must interrupt it by (command)
  1131.   after dimensioning.
  1132.  
  1133.   But it doesn't work, if you try to interrupt a lisp loop. There is
  1134.   another function (exit) or (quit) -they do the same-, which
  1135.   immediately break a Lisp program.
  1136.  
  1137.   Example:
  1138.  
  1139.   (while T ; do         ; a never ending loop
  1140.     (princ "\nEnter a=")
  1141.     (setq a (getint))
  1142.     (if (zerop a)(exit)) ; Breaks Lisp and returns to the command mode.
  1143.   )
  1144.  
  1145.   In this example (command) doesn't work. (exit) works exactly as
  1146.   Ctrl-C. It prints "error: quit / exit abort" and outputs all nested
  1147.   functions. To provide "silent" break you must include this error
  1148.   message to an error handling function, e.g.:
  1149.  
  1150.   (setq *olderr* *error* *error* my-error)
  1151.   (defun MY-ERROR (s)
  1152.     (if (not (member s            ; msgs of the english version:
  1153.        '("Function cancelled" "console break" "quit / exit abort")))
  1154.       (princ (strcat "\nError: " s))
  1155.     )
  1156.     (setq *error* *olderr*)
  1157.   )
  1158.  
  1159.   For scripts use this workaround by defining (cancel) in lisp, simply
  1160.   (defun SCRIPT-CANCEL ()
  1161.     (command)
  1162.     (command "resume")
  1163.   )
  1164.   and in a SCRIPT.SCR:
  1165.   ..
  1166.   [<script commands>]
  1167.   (script-cancel)
  1168.   [<more script commands>]
  1169.   ..
  1170.  
  1171. ------------------------------
  1172.  
  1173. Subject: [27.1] How to do an unlimited number of user prompts? [new]
  1174.  
  1175.   To let the user end any selected command without having to write
  1176.   code for every possible option, just repeat (command PAUSE) until
  1177.   the command is ended.
  1178.  
  1179.   ;; Sample by Owen Wengerd
  1180.   (command "_ARC")
  1181.   (while (= 1 (logand (getvar "CMDACTIVE") 1)) (command PAUSE))
  1182.  
  1183. ------------------------------
  1184.  
  1185. Subject: [28] How to decode ACIS internal geometry with Lisp?
  1186.  
  1187.   All the ACIS objects (3DSOLID) have been documented by Spatial ("SAT
  1188.   Format Description"). However the internal representation by (entget)
  1189.   is still encrypted, but the encryption scheme was hacked. (XOR 95)
  1190.  
  1191.   Samples and code are at:
  1192.   http://xarch.tu-graz.ac.at/autocad/stdlib/samples/ACIS-REGION.LSP
  1193.  
  1194. ------------------------------
  1195.  
  1196. Subject: [A] Disclaimer, Notes from the authors
  1197.  
  1198.   If you think of questions that are appropriate for this FAQ, or
  1199.   would like to improve an answer, please send email to Reini Urban
  1200.   <rurban@x-ray.at> but don't expect an reply.
  1201.  
  1202.   This AutoLISP FAQ is Copyright (c) 1996,97,98,99,2000 by Reini Urban.
  1203.  
  1204.   This FAQ may be freely redistributed in its entirety without
  1205.   modification, provided that this copyright notice is not removed. It
  1206.   may not be sold for profit or incorporated in commercial documents
  1207.   (e.g. published for sale on CD-ROM, floppy disks, books, magazines,
  1208.   or other print form) without the prior written permission of the
  1209.   copyright holder. Permission is expressly granted for this document
  1210.   to be made available for file transfer from installations offering
  1211.   unrestricted anonymous file transfer on the Internet (WWW, FTP) and
  1212.   esp. to be included into the official AutoCAD FAQ.
  1213.  
  1214.   The sample code is, if not otherwise stated, (c) 1996,97
  1215.   by Reini Urban and may be freely used, but not sold.
  1216.   The basic functions in [20] are, if not otherwise stated,
  1217.   (c) 1991-97 by Reini Urban and may/should be freely used.
  1218.  
  1219.   If this FAQ is reproduced in offline media (e.g., CD-ROM, print
  1220.   form, etc.), a complimentary copy should be sent to Reini Urban,
  1221.   X-RAY, Nibelungeng. 3, 8010 Graz, Austria
  1222.  
  1223.   This article, the contents and the sample code, is provided AS IS
  1224.   without any expressed or implied warranty.
  1225.  
  1226. ------------------------------
  1227.  
  1228. [A.1] FAQ Locations
  1229.  
  1230.   Homepage of the HTML'ified version:
  1231.     http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp.html
  1232. + Annotated AcadWiki version:
  1233. +   http://xarch.tu-graz.ac.at/acadwiki/AutoLispFaq
  1234.   The posted ascii versions (and always latest versions) are at
  1235.     http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp.1 and
  1236.     http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp.2
  1237.   The Winhelp version (zipped with faq and code) is at
  1238.     ftp://xarch.tu-graz.ac.at/pub/autocad/news/faq/autolisp.zip
  1239.   The FAQ usenet archive is at
  1240.     http://www.faqs.org/faqs/CAD/autolisp-faq/ resp.
  1241.     ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/comp/cad/autocad/
  1242.   The Lisp code from this FAQ is at
  1243.     ftp://xarch.tu-graz.ac.at/pub/autocad/news/faq/FAQ-CODE.LSP
  1244.   A french translation of the FAQ by Roger Rosec
  1245.     http://www.newz.net/acadplus/page5101.htm
  1246.   A japanese translation of the FAQ by MASAMI Chikahiro
  1247.     http://www.page.sannet.ne.jp/chestnutsburr/autolisp-j.html
  1248.   A russian translation of the FAQ by Igor Orellana at
  1249.     http://www.cad.dp.ua/stats/alfaq_ru.htm
  1250.   A german translation by myself at
  1251.     http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp.html.de
  1252. + A new spanish translation by Eduardo Magdalena
  1253. +   http://www.peletash.com/mecanicad/articulos/art02_0002.htm
  1254.   Relevant AutoDesk FAQ's and TechSupport
  1255.     http://www.autodesk.com/support/autocad/
  1256.     http://search.autodesk.com/query.html?qt=autocad+faq
  1257.     http://www.autodesk.com/support/autocad/asa2000.htm
  1258.   AutoDesk news groups
  1259.     news://discussion.autodesk.com/autodesk.autocad.customization
  1260.     http://groups.google.com/groups?oi=djq&as_ugroup=autodesk.autocad.customization
  1261.     or the new WebX interface at http://discussion.autodesk.com/
  1262.  
  1263. ------------------------------
  1264.  
  1265. Subject: [B] Acknowledgements
  1266.  
  1267.   This FAQ is based on great efforts of the the news://comp.cad.autocad
  1268.   community, in particular:
  1269.   Tom Berger, Adi Buturovic, Christoph Candido, Mike Clark, Miles
  1270.   Constable, Cara Denko, T.J. DiTullio, Chris Ehly, Jeff Foster, Rusty
  1271.   Gesner, William Kiernan, Paul Kohut, Sergei M. Komarov, Joseph
  1272. + M. Liston, Lu, Eduardo Magdalena, Masami Chikahiro, Georg Mischler,
  1273.   Desi Moreno, Vladimir Nesterovsky, Roger Rosec, Serge Pashkov,
  1274.   Dennis Shinn, Tony Tanzillo, Eugene Tenenbaum, Reinaldo Togores,
  1275.   Reini Urban, Serge Volkov, Morten Warankov, Owen Wengerd, Alan
  1276.   Williams, Doug Wilson, Ian A. White, David Whynot, Darren Young,
  1277.   Xiang Zhu and others.
  1278.  
  1279. ------------------------------
  1280.  
  1281. Subject: [C] Recent Changes
  1282.  
  1283. * 25.Jun 2002
  1284.   new spanish translation [A.1]
  1285. * 18.Jun 2001
  1286.   fixed deja.com to groups.google.com
  1287. * 23.Apr 2001, 14.Jun 2001
  1288.   fixed several links
  1289. * v2.28 4.Apr 2001
  1290.   changed rurban@sbox to rurban@x-ray.at (defunct in the next year)
  1291.   all parts of the faq are now in the acadwiki.
  1292. * v2.27 23.Sep 2000
  1293.   added [23.7] "How to get the CENTER of a polyline?"
  1294. * 15.Sep 2000
  1295.   changed stack-overflow [14] to better reflect VL/VLIDE, A2000,
  1296.   new book [2]
  1297. * 1.Sep 2000
  1298.   vl-sort warning with duplicate entries [8]
  1299. * 18.Aug 2000
  1300.   changed CodeMagic [6.1] from Freeware to Shareware, thanks to Nir Sullam
  1301. * 1.Aug 2000
  1302.   changed adesk faq location
  1303.  
  1304. * v2.26 6.Jun 2000
  1305.   added LDATA bug [7], fixed DEFUN-Q [11], 
  1306.   removed most colored [new/changed] notes
  1307. * v2.25 17.May 2000
  1308.   added [27.1], added C:POLYREV [23.6], texinfo versions
  1309. * 25.Apr 2000
  1310.   added Point A [1.1], shortened the DDE example in [21.2]
  1311. * 24.Apr 2000
  1312.   Vladimir fixed www.deja.com to deja.com/usenet [1.1]
  1313. * v2.24 20.Apr 2000
  1314.   renamed cadsyst.com to caddepot.com [1], added cadplugins.com [1],
  1315.   added rapidlisp [6.2]
  1316. * 30.Mar 2000
  1317.   renamed adesknews.autodesk.com to discussion.autodesk.com
  1318. * 9.Mar 2000
  1319.   added CodeMagic editor at [6.1], thanks to Nir Sullam
  1320. * 29.Feb 2000
  1321.   Masami Chikahiro fixed numeric range [7]: -32766 => -32768
  1322. * 17.Feb 2000
  1323.   Added the dotsoft buglist url.
  1324.   Mike Tuersley fixed [11] for MNL files.
  1325.   Owen: $600 US of ADN [1.2]
  1326.   
  1327. * v2.23 14.Feb 2000
  1328.   Chris Ehly fixed all broken links.
  1329.  
  1330. * v2.22 13.Jan 2000
  1331.   additions to numerical precision [7].
  1332.   adesk techdocs links are broken again.
  1333.   compiled S::STARTUP hooks [11].
  1334.  
  1335. * the full history is at
  1336.   http://xarch.tu-graz.ac.at/autocad/news/faq/autolisp_faq_history.txt
  1337.  
  1338. --
  1339. Reini Urban, Jun 25, 2002
  1340.