home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 10.img / BONUS3.LIB / XDATA.LSP < prev    next >
Encoding:
Text File  |  1993-02-08  |  16.3 KB  |  498 lines
  1. ;;;---------------------------------------------------------------------------;
  2. ;;;
  3. ;;;   XDATA.LSP   ¬⌐Ñ╗ 1.1
  4. ;;;
  5. ;;;   (C) ¬⌐┼v 1988-1992  Autodesk ñ╜Ñq
  6. ;;;
  7. ;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
  8. ;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
  9. ;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
  10. ;;;
  11. ;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
  12. ;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
  13. ;;;
  14. ;;;
  15. ;;;
  16. ;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
  17. ;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
  18. ;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
  19. ;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
  20. ;;;
  21. ;;;
  22. ;;;   by Kieran V. McKeogh, Brad Zehring
  23. ;;;   5 March 1990
  24. ;;;
  25. ;;;   Modified on March 11, 1991 by Kieran McKeogh.  (xdsize) check added.
  26. ;;;
  27. ;;;---------------------------------------------------------------------------;
  28. ;;;  DESCRIPTION
  29. ;;;
  30. ;;;   XDATA
  31. ;;;
  32. ;;;   Program that attaches extended data types to a selected entity.
  33. ;;;
  34. ;;;   After selecting an entity and entering an application name for the
  35. ;;;   extended data, the following types of extended data are prompted for:
  36. ;;;
  37. ;;;    1)  An ASCII string up to 255 bytes long (group code 1000).
  38. ;;;    2)  A layer name (group code 1003).
  39. ;;;    3)  An entity handle (group code 1005).
  40. ;;;    4)  3 real numbers (group code 1010).
  41. ;;;    5)  A 3D World space position (group code 1011).
  42. ;;;    6)  A 3D World space displacement (group code 1012).
  43. ;;;    7)  A 3D World space direction (group code 1013).
  44. ;;;    8)  A real number (group code 1040).
  45. ;;;    9)  A distance (group code 1041).
  46. ;;;   10)  A scale factor (group code 1042).
  47. ;;;   11)  A 16-bit integer (group code 1070).
  48. ;;;   12)  A 32-bit signed long integer (group code 1071).
  49. ;;;
  50. ;;;   Numbers 5, 6, 7, 9 and 10 are "transformable" data types, and
  51. ;;;   are either moved, scaled, rotated or mirrored along with the parent
  52. ;;;   entity, or possibly some combination of these, depending on the
  53. ;;;   group code and the nature of the operation on the parent entity.
  54. ;;;
  55. ;;;   Binary data chunks (group code 1004) are not supported.
  56. ;;;
  57. ;;;
  58. ;;;   XDLIST
  59. ;;;
  60. ;;;   Program that lists the Xdata associated with an application for the
  61. ;;;   selected entity.
  62. ;;;
  63. ;;;   For a complete description of extended data types see the "AutoCAD
  64. ;;;   Reference Manual."
  65. ;;;
  66. ;;;---------------------------------------------------------------------------;
  67.  
  68.  
  69. ;;;---------------------------------------------------------------------------;
  70. ;;; Internal error handling.
  71. ;;;---------------------------------------------------------------------------;
  72.  
  73. (defun xdataerr(s)
  74.   (if (/= s "Function cancelled")
  75.     (princ (strcat "\n┐∙╗~: " s))
  76.   )
  77.   (setq *error* olderr)
  78.   (if ename (redraw ename 4))         ; de-highlight entity
  79.   (princ)
  80. )
  81.  
  82. ;;;---------------------------------------------------------------------------;
  83. ;;; Get user input.
  84. ;;;---------------------------------------------------------------------------;
  85.  
  86. (defun getinput (/ cont esel)
  87.  
  88.   ;; Forces selection of an entity and sets ename to the name of the
  89.   ;; selected entity.
  90.  
  91.   (while
  92.     (not (setq esel (entsel)))
  93.   )
  94.  
  95.   (if (= which 1)                     ; If XDATA() is happening...
  96.     (progn
  97.       (setq ename (car esel))         ; Get entity info...
  98.       (redraw ename 3)                ; ...highlight entity
  99.       (setq elist (entget ename (list "*"))) ; ...including xdata for all
  100.                                       ; registered applications.
  101.  
  102.       ;; Force the entry of a registered application name (group code 1001).
  103.  
  104.       (setq cont T)
  105.       (while cont
  106.         (setq rname (strcase (getstring "\níu└│Ñ╬├■╢╡ívªW║┘: ")))
  107.         (if (/= rname "")
  108.           (setq cont nil)
  109.         )
  110.       )
  111.     )
  112.   )
  113.   (if (= which 2)                     ; If XDPRINT() is happening...
  114.     (progn
  115.       (setq ename (car esel))         ; Get entity info
  116.       (redraw ename 3)                ; ...highlight entity
  117.       (setq rname (strcase (getstring "\níu└│Ñ╬├■╢╡ívªW║┘ <*>: ")))
  118.       (if (= rname "")                ; If null input, get all.
  119.         (setq rname "*")
  120.       )
  121.       (setq elist (entget ename (list rname)))
  122.     )
  123.   )
  124. )
  125.  
  126. ;;;---------------------------------------------------------------------------;
  127. ;;; Get user values for extended entity data and build XD_LIST.
  128. ;;;---------------------------------------------------------------------------;
  129.  
  130. (defun getdata (/ xd_type)
  131.  
  132.   (setq xflag 0)
  133.  
  134.   ;; Check whether the selected entity has some extended data already.
  135.  
  136.   (if (assoc -3 elist)
  137.     (progn
  138.       (setq size_old (xdsize (assoc -3 elist)))
  139.       (princ "\n╣╧ñ╕ª│ ")
  140.       (princ size_old )
  141.       (princ " byte ¬║ Xdata í╨ ╖s¬║ Xdata ▒N│QÑ[ñJíC\n")
  142.     )
  143.   )
  144.  
  145.   (setq xd_list (list '(1002 . "}"))) ; Initialize list of xdata for this app.
  146.  
  147.   (setq xd_type T)                    ; Initialize loop terminator.
  148.  
  149.   (while (not (or (eq xd_type "EXit") (eq xd_type "Xit") (eq xd_type nil)))
  150.     (setq hand (getvar "handles"))
  151.     (initget                          ; Initialize keyword list.
  152.       (strcat "STring LAyer 3Real Position DISPlacement Handle"
  153.             " DIRection Real DISTance SCale"
  154.             " Integer LOng EXit Xit"
  155.  
  156.       )
  157.     )
  158.  
  159.     (setq xd_type (getkword (strcat   ; Prompt user to select keyword.
  160.        "\n3R╣Ω╝╞/DIRñΦªV/DISPª∞▓╛/DIST╢Z┬≈/Hñ▐╝╨/I╛π╝╞/"
  161.        "\nLA╣╧╝h/LO¬°╛π╝╞/Pª∞╕m/R╣Ω╝╞/SCñ±¿╥½Y╝╞/STªrªΩ/<X░hÑX>: "))
  162.     )
  163.  
  164.     ;; Add sub-list to xdata list.
  165.  
  166.     (cond
  167.       ((eq xd_type "3Real")
  168.         (if (/= (setq input (getpoint "\n3 ╣Ω╝╞: ")) nil)
  169.            (setq xd_list (cons (cons 1010 input) xd_list))
  170.         )
  171.       )
  172.       ((eq xd_type "DIRection")
  173.         (if (/= (setq input (getpoint "\n3D Ñ@¼╔¬┼╢ííuñΦªVív: ")) nil)
  174.           (setq xd_list (cons (cons 1013 input) xd_list))
  175.         )
  176.       )
  177.       ((eq xd_type "DISPlacement")
  178.         (if (/= (setq input (getpoint "\n3D Ñ@¼╔¬┼╢ííuª∞▓╛ív: ")) nil)
  179.           (setq xd_list (cons (cons 1012 input) xd_list))
  180.         )
  181.       )
  182.       ((eq xd_type "DISTance")
  183.         (if (/= (setq input (getdist "\n╢Z┬≈: ")) nil)
  184.           (setq xd_list (cons (cons 1041 input) xd_list))
  185.         )
  186.       )
  187.       ((eq xd_type "Handle")
  188.         (if (or ( = (setq hand (getstring "\n╕Ω«╞«wíuñ▐╝╨ív: ")) "0")
  189.                 (handent hand)
  190.             )
  191.           (setq xd_list (cons (cons 1005 hand) xd_list))
  192.           (if (/= hand "")
  193.             (princ "\níuñ▐╝╨ív╡L«─ í╨ ñ▐╝╨Ñ▓╢╖íuªsªbív⌐╬¼░íu0ívíC")
  194.           )
  195.         )
  196.       )
  197.       ;; Values entered greater than 32767 cause AutoLISP to issue an
  198.       ;; error message stating "Value must be between -32767 and 32767. "
  199.       ;; Values less than 0 are trapped out by the (initget).  Though the
  200.       ;; message may be confusing, the values are always correct.  This is
  201.       ;; an AutoLISP limitation.
  202.       ((eq xd_type "Integer")
  203.         (initget 4)
  204.         (if (/= (setq input (getint "\níu16-bitív╛π╝╞: ")) nil)
  205.           (setq xd_list (cons (cons 1070 input) xd_list))
  206.         )
  207.       )
  208.       ((eq xd_type "LAyer")
  209.         (setq input (getstring "\n╝hªW: "))
  210.         (if (tblsearch "layer" input)
  211.           (setq xd_list (cons (cons 1003 input) xd_list))
  212.           (if (/= input "")
  213.             (princ "\níu╝hªWív╡L«─ í╨ ╣╧╝hÑ▓╢╖ªsªbíC")
  214.           )
  215.         )
  216.       )
  217.       ((eq xd_type "LOng")
  218.         (if (/= (setq input (getint "\níu32-bitív▒a╕╣¬°╛π╝╞: ")) nil)
  219.           (setq xd_list (cons (cons 1071 input) xd_list))
  220.         )
  221.       )
  222.       ((eq xd_type "Position")
  223.         (if (/= (setq input (getpoint "\n3D Ñ@¼╔¬┼╢ííuª∞╕mív: ")) nil)
  224.           (setq xd_list (cons (cons 1011 input) xd_list))
  225.         )
  226.       )
  227.       ((eq xd_type "Real")
  228.         (if (/= (setq input (getreal "\n╣Ω╝╞: ")) nil)
  229.           (setq xd_list (cons (cons 1040 input) xd_list))
  230.         )
  231.       )
  232.       ((eq xd_type "SCale")
  233.         (if (/= (setq input (getreal "\nñ±¿╥½Y╝╞: ")) nil)
  234.           (setq xd_list (cons (cons 1042 input) xd_list))
  235.         )
  236.       )
  237.       ((eq xd_type "STring")
  238.         (setq xd_list (cons (cons 1000 (getstring T
  239.           "\nASCII ªrªΩ: ")) xd_list))
  240.       )
  241.       (t)
  242.     )
  243.   )
  244.  
  245.   ;; Was any xdata entered besides a registered application name ??
  246.  
  247.   (setq xflag (length xd_list))
  248.  
  249.   ;; Append opening brace to front of xdata list.
  250.  
  251.   (setq xd_list (cons '(1002 . "{") xd_list))
  252.  
  253.   ;; Append application name to front of xdata list.
  254.  
  255.   (setq xd_list (cons rname xd_list))
  256.  
  257.   ;; Append -3 group code to front of list containing xdata list.
  258.  
  259.   (setq xd_list (list -3 xd_list))
  260.  
  261.   ;; Find the total size of the new xdata.
  262.  
  263.   (setq size_new (xdsize xd_list))
  264. )
  265.  
  266.  
  267. ;-----------------------------------------------------------------------------;
  268. ; XDATA
  269. ;-----------------------------------------------------------------------------;
  270.  
  271. (defun c:xdata (/ all elist ename old olderr new rname size_new xd_list
  272.                   xd_list1 xd_list2 xd_list3 xd_ent regflag hand xflag
  273.                   size_old which)
  274.  
  275.  
  276.  
  277.   (setq olderr *error*                ; Use special error handling function.
  278.         *error* xdataerr)
  279.  
  280.   (setq which 1)                      ; Flag for (getinput)
  281.  
  282.   (setq regflag 0)                    ; Regapp flag.
  283.  
  284.   (getinput)                          ; Prompt for user input
  285.  
  286.   (redraw ename 4)                    ; De-highlight entity
  287.  
  288.  
  289.  
  290.   (if (regapp rname)                  ; Register the application name.
  291.     (princ (strcat "\n" rname " í╨ ╖síu└│Ñ╬├■╢╡ívíC\n"))
  292.     (princ (strcat "\n└│Ñ╬├■╢╡íu" rname "ívñw╡n░OíC\n"))
  293.   )
  294.  
  295.   ;; Prompt for user values for xdata and build xdata list XD_LIST.
  296.  
  297.   (getdata)
  298.  
  299.   ;; The extended data list is now added to the entity data.  This is a
  300.   ;; little more involved if the entity already has extended data.  A check
  301.   ;; of available Xdata space must be made too.
  302.  
  303.   (if (< size_new (xdroom ename))     ; If there is room for more...
  304.     (progn
  305.       (if (assoc -3 elist)            ; and contains xdata already...
  306.         (progn
  307.           (setq xd_list (cdr xd_list)) ; New xdata.
  308.           (setq xd_ent (cdr (assoc -3 elist))) ; Old xdata.
  309.           ;; Find old xdata with same regapp
  310.           (if (setq old (cddr (assoc rname xd_ent)))
  311.             (progn
  312.               (setq regflag 1)
  313.               (setq new (cdr (reverse (cddr (assoc rname xd_list)))))
  314.               (setq all (append new old)) ; Join old and new xdata with
  315.                                       ; same application name.
  316.               (setq xd_list1 (cons (cons 1002 "{") all)) ; Add open curly
  317.               (setq xd_list2 (cons rname xd_list1)) ; Add regapp
  318.  
  319.               ;; Substitute back into existing xdata list.
  320.  
  321.               (setq xd_list3 (subst xd_list2 (assoc rname xd_ent)
  322.                                              (assoc -3 elist)))
  323.            )
  324.             (progn                    ; This is a new regapp...
  325.               (setq xd_list (append xd_ent xd_list)) ; Joins xdata.
  326.               (setq xd_list3 (cons -3 xd_list))
  327.             )
  328.           )
  329.           (setq elist (subst xd_list3 (assoc -3 elist) elist)) ; Joins entity
  330.         )
  331.         (setq elist (cons xd_list elist)) ; No xdata yet.
  332.       )
  333.  
  334.     )
  335.     (princ (strcat "\n╣╧ñ╕ñ╣Ñ╬¬║íuXdata «e┐n (space)ívñú¿¼"
  336.                    " í╨ Ñ╝Ñ[ñJ╖s¬║íuXdataívíC")
  337.     )
  338.   )
  339.  
  340.   ;; Finally update the entity in the database to contain the new xdata.
  341.  
  342.   (if (entmod elist)
  343.     (if (and (= 1 regflag) (<= xflag 1))   ; old application name
  344.       (princ "\nÑ╝Ñ[ñJíuxdataívíC")
  345.       (princ "\nÑ[ñJ╖s¬║íuxdataívíC")
  346.     )
  347.   )
  348.  
  349.   (setq *error* olderr)               ; Reset the error function.
  350.   (redraw ename 4)                    ; Dehighlight entity.
  351.  
  352.   (prin1)
  353. )
  354.  
  355. ;;;---------------------------------------------------------------------------;
  356. ;;;  XDLIST
  357. ;;;---------------------------------------------------------------------------;
  358.  
  359. (defun C:XDLIST (/ linecount xd_list app_list app_sub_list xd_code
  360.                    xd_data rname elist ename)
  361.  
  362.   (setq olderr *error*                ; Redefine error handler.
  363.         *error* xdataerr)
  364.  
  365.   (setq which 2)                      ; Flag for (getinput)
  366.  
  367.   (getinput)                          ; Get user input.
  368.  
  369.   (redraw ename 4)                    ; De-highlight entity.
  370.  
  371.   ;; See if there's any xdata in the selected entity associated with the
  372.   ;; application name.
  373.  
  374.   (if (not (setq xd_list (assoc -3 elist)))
  375.     (progn
  376.       (princ "\n¿Sª│╗Píu└│Ñ╬├■╢╡ív├÷┴p¬║íuXdataívíC")
  377.     )
  378.     (setq xd_list (cdr xd_list))      ; Strip -3 from xd_list
  379.   )
  380.  
  381.   (setq linecount 0)                  ; # of lines printed
  382.  
  383.   (while xd_list                      ; There's any xdata left...
  384.     (setq app_list (car xd_list))
  385.     (textscr)
  386.     (princ "\n\n* ñw╡n░O¬║íu└│Ñ╬├■╢╡ívªW║┘: ")
  387.     (princ (car app_list))
  388.     (setq app_list (cdr app_list))    ; Strip app name
  389.     (while app_list
  390.       (setq app_sub_list (car app_list))  ; Get sub list
  391.       (setq xd_code (car app_sub_list))   ; Get group code
  392.       (setq xd_data (cdr app_sub_list))   ; Get data
  393.  
  394.       ;; Conditions for all group codes.
  395.       ;; Prints 'em all except binary chunks.
  396.       (cond
  397.         ((= 1000 xd_code)
  398.           (princ "\n* ╜X 1000, ASCII ªrªΩ: ")
  399.           (princ xd_data)
  400.         )
  401.         ((= 1001 xd_code)
  402.           (princ "\n* ╜X 1001, ñw╡n░Oíu└│Ñ╬├■╢╡ívªW║┘: ")
  403.           (princ xd_data)
  404.         )
  405.         ((= 1002 xd_code)
  406.           (princ "\n* ╜X 1002,íu░_⌐lív⌐╬íu╡▓º⌠ív¼A╕╣: ")
  407.           (princ xd_data)
  408.         )
  409.         ((= 1003 xd_code)
  410.           (princ "\n* ╜X 1003, ╝hªW: ")
  411.          (princ xd_data)
  412.         )
  413.         ((= 1004 xd_code)
  414.           (princ "\n* ╜X 1004, Ñ╝ªLÑ▄¬║íuñG╢iª∞╕Ω«╞ívíC")
  415.         )
  416.         ((= 1005 xd_code)
  417.           (princ "\n* ╜X 1005, ╕Ω«╞«wíuñ▐╝╨ív: ")
  418.           (princ xd_data)
  419.         )
  420.         ((= 1010 xd_code)
  421.           (princ "\n* ╜X 1010, 3 ╣Ω╝╞: ")
  422.           (princ (strcat "("
  423.                  (rtos (car xd_data)) " "
  424.                  (rtos (cadr xd_data)) " "
  425.                  (rtos (caddr xd_data)) ")"))
  426.         )
  427.         ((= 1011 xd_code)
  428.           (princ "\n* ╜X 1011, 3D Ñ@¼╔¬┼╢ííuª∞╕mív: ")
  429.           (princ (strcat "("
  430.                  (rtos (car xd_data)) " "
  431.                  (rtos (cadr xd_data)) " "
  432.                  (rtos (caddr xd_data)) ")"))
  433.         )
  434.         ((= 1012 xd_code)
  435.           (princ "\n* ╜X 1012, 3D Ñ@¼╔¬┼╢ííuª∞▓╛ív: ")
  436.           (princ (strcat "("
  437.                  (rtos (car xd_data)) " "
  438.                  (rtos (cadr xd_data)) " "
  439.                  (rtos (caddr xd_data)) ")"))
  440.         )
  441.         ((= 1013 xd_code)
  442.           (princ "\n* ╜X 1013, 3D Ñ@¼╔¬┼╢ííuñΦªVív: ")
  443.           (princ (strcat "("
  444.                  (rtos (car xd_data)) " "
  445.                  (rtos (cadr xd_data)) " "
  446.                  (rtos (caddr xd_data)) ")"))
  447.         )
  448.         ((= 1040 xd_code)
  449.           (princ "\n* ╜X 1040, ╣Ω╝╞: ")
  450.           (princ (rtos xd_data))
  451.         )
  452.         ((= 1041 xd_code)
  453.           (princ "\n* ╜X 1041, ╢Z┬≈: ")
  454.           (princ (rtos xd_data))
  455.         )
  456.         ((= 1042 xd_code)
  457.           (princ "\n* ╜X 1042, ñ±¿╥½Y╝╞: ")
  458.           (princ (rtos xd_data))
  459.         )
  460.         ((= 1070 xd_code)
  461.           (princ "\n* ╜X 1070,íu16-bitív╛π╝╞: ")
  462.           (princ xd_data)
  463.         )
  464.         ((= 1071 xd_code)
  465.           (princ "\n* ╜X 1071,íu32-bitív▒a╕╣¬°╛π╝╞: ")
  466.           (princ (rtos xd_data 2 0))
  467.         )
  468.         (t
  469.           (princ "\n* ñú⌐·¬║íuxdata ╜Xív: ")
  470.           (princ xd_code)
  471.           (princ " *")
  472.         )
  473.       )
  474.       (setq app_list (cdr app_list))
  475.       (setq linecount (1+ linecount))
  476.       (if (>= linecount 20)           ; Pause at 20 lines printed.
  477.         (progn
  478.           (getstring "\n-▒╡ñU¡╢-")
  479.           (setq linecount 0)
  480.         )
  481.       )
  482.     )
  483.   (setq xd_list (cdr xd_list))        ; Get next xdata list.
  484. )
  485.  
  486.  
  487.   (princ "\n\n╣╧ñ╕ª│ ")
  488.   (princ (xdroom ename))              ; Figure how much room is left.
  489.   (princ " bytes ñ╣Ñ╬¬║íuXdata «e┐n (space)ívíC")
  490.  
  491.   (setq *error* olderr)               ; Reset the error function.
  492.   (prin1)                             ; Quiet exit.
  493.  
  494. )
  495. ;;;---------------------------------------------------------------------------;
  496. (princ "\níuC:XDATAívñw╕ⁿñJ; ╜╨┐ΘñJ XDATA ñ╬ XDLIST ¿╙⌐w╕q╗PªCÑ▄╕Ω«╞íC ")
  497. (princ)
  498.