Liren Large Software Subsidy 13/13.iso/p/p024/5.img/SUPPORT2.LIB/DDATTDEF.LSP

Text File | 1993-02-08 | 17.9 KB | 579 lines

;;;------------------------------------------------------------------------
;;;  DDATTDEF.LSP
;;;  ¬⌐┼v (C) 1992  Autodesk ñ╜Ñq
;;;
;;;  Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
;;;  ¡∞½h :
;;;
;;;  1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
;;;  2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
;;;
;;;  Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
;;;  Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
;;;
;;;
;;;------------------------------------------------------------------------
;;;  DESCRIPTION
;;;
;;;  This is an enhancement to the ATTDEF command. It loads up a dialogue box
;;;  which presents the user the set of options for attribute definition.
;;;
;;;------------------------------------------------------------------------
;;;   Prefixes in command and keyword strings:
;;;      "."  specifies the built-in AutoCAD command in case it has been
;;;           redefined.
;;;      "_"  denotes an AutoCAD command or keyword in the native language
;;;           version, English.
;;;------------------------------------------------------------------------
;;;
;;; ===================== load-time error checking ========================

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " └│Ñ╬╡{ªí┐∙╗~: "
                      app
                      " \n\n  "
                      msg
                      "  \n"
              )
       )
     )
     (exit)
  )

;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load it.
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.

  (cond
     (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.

     (  (not (findfile "ai_utils.lsp"))                     ; find it
        (ai_abort "DDATTDEF"
                  (strcat "ºΣñú¿∞íuAI_UTILS.LSPív└╔«╫;"
                          "\n  ╜╨└╦¼díusupportívÑ╪┐²íC")))

     (  (eq "failed" (load "ai_utils" "failed"))            ; load it
        (ai_abort "DDATTDEF" "╡L¬k╕ⁿñJíuAI_UTILS.LSPív└╔«╫"))
  )

  (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
      (ai_abort "DDATTDEF" nil)         ; a Nil <msg> supresses
  )                                    ; ai_abort's alert box dialog.

;;; ==================== end load-time operations =========================

(defun c:ddattdef ( /
                   aflags       def_val      pt2          x_temp
                   align_prev   height       rot          y_pt
                   att_exist    i            style_list   y_temp
                   att_prompt   justif_list  tag          z_pt
                   att_tag      old_cmd      tstyle p     z_temp
                   c            old_error    v
                   cjustif      p            what_next
                   dcl_id       pt           x_pt         undo_init
                  )

  (setq aflags (getvar "aflags"))  ; Get attribute mode system variable

  ;;
  ;;  This function creates 2 lists. The first one: style_list is a list of
  ;;  available text styles. The second one: justif_list is a list of text
  ;;  justifications.
  ;;
  (defun load_list ()

    (setq style_list (ai_table "style" 4))
    (if (>= (getvar "maxsort") (length style_list))
      (setq style_list (acad_strlsort style_list))
    )
    (setq justif_list (list "Left"     "Align"     "Fit"       "Center"
                            "Middle"   "Right"
                            "Top Left"      "Top Center"    "Top Right"
                            "Middle Left"   "Middle Center" "Middle Right"
                            "Bottom Left"   "Bottom Center" "Bottom Right"
                      )
    )
  )
  ;;
  ;;  Initilization of variables.
  ;;
  (defun init_variables ()
    (setq tstyle
            (itoa (- (length style_list)
                  (length (member (strcase (getvar "textstyle")) style_list))
                  ))
          cjustif    "0"
          height     (rtos (getvar "textsize"))
          att_exist  (ssget "x" (list (cons 0 "attdef")))
          what_next  5
          align_prev "0"
    )
    (if (not pt) (setq pt (list 0.0 0.0 0.0)))

    (setq x_pt (rtos (car pt))
          y_pt (rtos (cadr pt))
          z_pt (rtos (caddr pt))
    )
    (if (not rot) (setq rot (angtos 0.0)))
  )
  ;;
  ;;  Initialization of tiles. Called in main program loop.
  ;;
  (defun init_tiles ()
    (if att_tag (set_tile "att_tag" att_tag))
    (if att_prompt (set_tile "att_prompt" att_prompt))
    (if def_val (set_tile "def_val" def_val))
    (if (not att_exist)
      (mode_tile "align_prev" 1)
      (set_tile "align_prev" align_prev)
    )

    ;parse attribute mode local variable "aflags" in case it changed,
    ;for setting state of mode radio buttons.
    (if (/= 0 (logand 1 aflags))
      (setq i "1")
      (setq i "0")
    )
    (if (/= 0 (logand 2 aflags))
      (progn (setq c "1") (prompt_set))
      (setq c "0")
    )
    (if (/= 0 (logand 4 aflags))
      (setq v "1")
      (setq v "0")
    )
    (if (/= 0 (logand 8 aflags))
      (setq p "1")
      (setq p "0")
    )

    (set_tile "invisible" i)
    (set_tile "constant" c)
    (set_tile "verify" v)
    (set_tile "preset" p)

    (set_tile "x_pt" x_pt)
    (set_tile "y_pt" y_pt)
    (set_tile "z_pt" z_pt)

    (start_list "tstyle")
    (mapcar 'add_list style_list)
    (end_list)
    (set_tile "tstyle" tstyle)

    (start_list "cjustif")
    (mapcar 'add_list justif_list)
    (end_list)
    (set_tile "cjustif" cjustif)

    (set_tile "height" height)

    (set_tile "rot" rot)

    (cond                                      ; set focus
      ((= 2 what_next)(mode_tile "x_pt" 2))
      ((= 3 what_next)(mode_tile "height" 2))
      ((= 4 what_next)(mode_tile "rot" 2))
      ((= 5 what_next)(mode_tile "att_tag" 2))
    )
  )
  ;;
  ;; If the current justification is aligned or if the current text style has
  ;; a non zero height, disable the height button and edit box.  Also
  ;; disable/enable rotation if justification is fit or align.
  ;;
  (defun grey_height()
    (if (or (= 1 (atoi cjustif))
            (/= 0.0 (cdr (cadddr
                           (tblsearch "style" (nth (atoi tstyle) style_list))
            )))
        )
      (progn
        (mode_tile "height" 1)
        (mode_tile "bheight" 1)
      )
      (progn
        (mode_tile "height" 0)
        (mode_tile "bheight" 0)
      )
    )
    (if (or (= 1 (atoi cjustif))
            (= 2 (atoi cjustif))
        )
      (progn
        (mode_tile "rot" 1)
        (mode_tile "brot" 1)
      )
      (progn
        (mode_tile "rot" 0)
        (mode_tile "brot" 0)
      )
    )
  )
  ;;
  ;; Update the local aflags variable (attribute mode).
  ;;
  (defun update_aflags()
    (setq aflags 0)
    (if (= "1" i) (setq aflags (+ 1 aflags)))
    (if (= "1" c) (setq aflags (+ 2 aflags)))
    (if (= "1" v) (setq aflags (+ 4 aflags)))
    (if (= "1" p) (setq aflags (+ 8 aflags)))
  )
  ;;
  ;; Reset the error tile to nil.
  ;;
  (defun rs_error()
    (set_tile "error" "")
  )
  ;;
  ;;  Get all the actions associated with each tile.
  ;;
  (defun get_actions ()
    (action_tile "invisible"  "(setq i $value)(update_aflags)")
    (action_tile "constant"   "(setq c $value)(prompt_set)(update_aflags)")
    (action_tile "verify"     "(setq v $value)(update_aflags)")
    (action_tile "preset"     "(setq p $value)(update_aflags)")
    (action_tile "att_tag"    "(rs_error)(tag_check (setq att_tag $value))")
    (action_tile "att_prompt" "(rs_error)(setq att_prompt $value)")
    (action_tile "def_val"    "(rs_error)(setq def_val $value)")
    (action_tile "pick_pt" "(get_tag)(done_dialog 2)")

    (action_tile "align_prev"
                 "(rs_error)(setq align_prev $value)(en_dis_able)")
    (action_tile "x_pt"
                 "(rs_error)(ai_num (setq x_pt $value) \"Invalid X coordinate.\" 0)")
    (action_tile "y_pt"
                 "(rs_error)(ai_num (setq y_pt $value) \"Invalid Y coordinate.\" 0)")
    (action_tile "z_pt"
                 "(rs_error)(ai_num (setq z_pt $value) \"Invalid Z coordinate.\" 0)")

    (action_tile "cjustif" "(rs_error)(setq cjustif $value) (grey_height)")
    (action_tile "tstyle"  "(rs_error)(setq tstyle $value)(grey_height)")
    (action_tile "height"
                 "(rs_error)(ai_num (setq height $value) \"Invalid Height.\" 6)")
    (action_tile "bheight" "(get_tag)(done_dialog 3)")
    (action_tile "rot"
                 "(rs_error)(ai_angle (setq rot $value) \"Invalid Rotation angle.\")")
    (action_tile "brot" "(get_tag)(done_dialog 4)")
    (action_tile "accept"  "(check_input)")
    (action_tile "cancel"  "(done_dialog 0)")
    (action_tile "help"    "(acad_helpdlg \"acad.hlp\" \"ddattdef\")")

    (setq what_next (start_dialog))
    (cond
      ; Drops dialogue box temporarily and lets user pick a point.
      ((= 2 what_next)
        (initget 1)
        (setq pt (getpoint "\n░_⌐l┬I: ")
              x_pt (rtos (car pt))
              y_pt (rtos (cadr pt))
              z_pt (rtos (caddr pt))
        )
      )
      ; Drops dialogue box temporarily and lets user pick a height.
      ((= 3 what_next)
        (temp_pt)
        (initget 1)
        (setq height (rtos (getdist pt "\nªr░¬: ")))
      )
      ; Drops dialogue box temporarily and lets user pick an angle.
      ((= 4 what_next)
        (temp_pt)
        (initget 1)
        (setq rot (angtos (getangle pt "\n▒█┬α¿ñ: ")))
      )
    )
  )
  (defun get_tag ()
    (setq att_tag (get_tile "att_tag"))
    (setq att_prompt (get_tile "att_prompt"))
    (setq def_val (get_tile "def_val"))
  )
  ;;
  ;; When picking height and rotation from the graphics screen a base point
  ;; of the Start Point is used.  However, the X, Y or Z fields could
  ;; contain invalid information, so these fields have to be checked and
  ;; if the data is invalid, a coordinate of 0.0 is used.
  ;;
  (defun temp_pt()
    (if (not (setq x_temp (distof x_pt))) (setq x_temp 0.0))
    (if (not (setq y_temp (distof y_pt))) (setq y_temp 0.0))
    (if (not (setq z_temp (distof z_pt))) (setq z_temp 0.0))
    (setq pt (list x_temp y_temp z_temp))
  )
  ;;
  ;;  Enables and disables the pick point feature if action_tile
  ;;  "next" is picked. The "next" action tile is enabled only if
  ;;  an attribute has been previously defined. The function of
  ;;  "next" is to place the attribute right under the previously
  ;;  defined attribute.
  ;;
  (defun en_dis_able ()
    (if (= 1 (atoi align_prev))
      (progn
        (mode_tile "pick_pt" 1)
        (mode_tile "x_pt" 1)
        (mode_tile "y_pt" 1)
        (mode_tile "z_pt" 1)
        (mode_tile "cjustif" 1)
        (mode_tile "tstyle" 1)
        (mode_tile "height" 1)
        (mode_tile "bheight" 1)
        (mode_tile "rot" 1)
        (mode_tile "brot" 1)
      )
      (progn
        (mode_tile "pick_pt" 0)
        (mode_tile "x_pt" 0)
        (mode_tile "y_pt" 0)
        (mode_tile "z_pt" 0)
        (mode_tile "cjustif" 0)
        (mode_tile "tstyle" 0)
        (mode_tile "height" 0)
        (mode_tile "bheight" 0)
        (mode_tile "rot" 0)
        (mode_tile "brot" 0)
        (grey_height)                ; Height could still be disabled.
      )
    )
  )
  ;;
  ;;  Enables or disables the attribute prompt tile. If constant is turned on
  ;;  then attribute prompt is disabled. If not, attribute prompt is enabled.
  ;;
  (defun prompt_set ()
    (if (= c "1")
      (progn
        (mode_tile "att_prompt" 1)
        (mode_tile "verify" 1)
        (mode_tile "preset" 1)
      )
      (progn
        (mode_tile "att_prompt" 0)
        (mode_tile "verify" 0)
        (mode_tile "preset" 0)
      )
    )
  )
  ;;
  ;;  Checks the validity of a tag and return the tag name if correct
  ;;  and nil otherwise.
  ;;
  (defun tag_check (tag)
    (cond
      ((= "" tag)
        (set_tile "error" "ñúñ╣Ñ╬íuNullív╝╨┼╥íC")
        nil
      )
      ((wcmatch tag "* *")
        (set_tile "error" "íu╝╨┼╥ívññª│╡L«─¬║¬┼«µíC")
        nil
      )
      (T tag)
    )
  )
  ;;
  ;;  check_input is called when Ok button is picked. Uses tag_check to check
  ;;  the tag for invalid values such as a space or an empty string.  Convert
  ;;  strings to reals where necessary.
  ;;
  (defun check_input()
    (setq att_tag (get_tile "att_tag"))
    (cond
      ((not (tag_check (get_tile "att_tag")))(mode_tile "att_tag" 2))
      ((and (= 0 (atoi align_prev))
            (not (setq x_pt
                       (ai_num (get_tile "x_pt") "íuX «y╝╨ív╡L«─íC" 0))
            )
       )
        (mode_tile "x_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (setq y_pt
                       (ai_num (get_tile "y_pt") "íuY «y╝╨ív╡L«─íC" 0))
            )
       )
        (mode_tile "y_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (setq z_pt
                       (ai_num (get_tile "z_pt") "íuZ «y╝╨ív╡L«─íC" 0))
            )
       )
        (mode_tile "z_pt" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (or (= 1 (atoi cjustif))
                     (/= 0.0 (cdr (cadddr (tblsearch "style" (nth (atoi tstyle) style_list)))))
                 )
            )
            (not (setq height
                       (ai_num (get_tile "height") "íuªr░¬ív╡L«─íC" 6))
            )
       )(mode_tile "height" 2)
      )
      ((and (= 0 (atoi align_prev))
            (not (or (= 1 (atoi cjustif))
                     (= 2 (atoi cjustif))
            ))
            (not (setq rot
                       (ai_angle (get_tile "rot") "íu▒█┬α¿ñív╡L«─íC"))
            )
       )
        (mode_tile "rot" 2)
      )
      (T (setq pt (list x_pt y_pt z_pt))(done_dialog 1))
    )
  )
  ;;
  ;;  Function actually starts the attribute definition command.
  ;;
  (defun start_command ()
    (setvar "aflags" aflags)
    (setvar "textstyle" (nth (atoi tstyle) style_list))

    (command "_.attdef" "")
    (command att_tag)
    (if (= c "0")
      (progn
        (if att_prompt
          (command att_prompt)
          (command "")
        )
      )
    )
    (if def_val
      (command def_val)
      (command "")
    )
    (if (= 0 (atoi align_prev))
      (progn
        (cond
          ((= (atoi cjustif) 0)  ;  left
            (command (list x_pt y_pt z_pt))
          )
          ((= (atoi cjustif) 1)  ;  aligned
            (setq pt (getpoint "\nñσªr░≥╖╟╜u 1: ")
                  pt2 (getpoint pt "\nñσªr░≥╖╟╜u 2: ")
            )
            (command "_j" "_a" pt pt2)
          )
          ((= (atoi cjustif) 2)  ;  fit
            (setq pt (getpoint "\nñσªr░≥╖╟╜u 1: ")
                  pt2 (getpoint pt "\nñσªr░≥╖╟╜u 2: ")
            )
            (command "_j" "_f" pt pt2)
          )
          ((= (atoi cjustif) 3)  ;  center
            (command "_j" "_c" pt)
          )
          ((= (atoi cjustif) 4)  ;  middle
            (command "_j" "_m" pt)
          )
          ((= (atoi cjustif) 5)  ;  right
            (command "_j" "_r" pt)
          )
          ((= (atoi cjustif) 6)  ;  top left
            (command "_j" "_tl" pt)
          )
          ((= (atoi cjustif) 7)  ;  top center
            (command "_j" "_tc" pt)
          )
          ((= (atoi cjustif) 8)  ;  top right
            (command "_j" "_tr" pt)
          )
          ((= (atoi cjustif) 9)  ;  middle left
            (command "_j" "_ml" pt)
          )
          ((= (atoi cjustif) 10)  ;  middle center
            (command "_j" "_mc" pt)
          )
          ((= (atoi cjustif) 11)  ;  middle right
            (command "_j" "_mr" pt)
          )
          ((= (atoi cjustif) 12)  ;  bottom left
            (command "_j" "_bl" pt)
          )
          ((= (atoi cjustif) 13)  ;  bottom center
            (command "_j" "_bc" pt)
          )
          ((= (atoi cjustif) 14)  ;  bottom right
            (command "_j" "_br" pt)
          )
        )
        (if (not (or (= 1 (atoi cjustif))
                     (/= 0.0 (cdr (cadddr (tblsearch "style"
                                            (nth (atoi tstyle) style_list)))
                             )
                     )
                 )
            )
          (command height)
        )
        (if (not (or (= 1 (atoi cjustif))
                     (= 2 (atoi cjustif))
                 )
            )
          (command rot)
        )
      )
      (command "") ; if user picks next for start point then the
                   ; attribute tag goes to the line below the
                   ; previous tag.
    )
  )
  ;;
  ;; Pop up the dialogue.
  ;;
  (defun ddattdef_main()

    (setq height (rtos (getvar "textsize")))
    (load_list)
    (init_variables)
    (while (> what_next 1)
      (if (not (new_dialog "ddattdef" dcl_id))
        (exit)
      )
      (init_tiles)
      (grey_height)
      (get_actions)
    )
    (if (= 1 what_next) (start_command))
  )

  ;; Set up error function.
  (setq old_cmd (getvar "cmdecho")    ; save current setting of cmdecho
        old_error  *error*            ; save current error function
        *error* ai_error              ; new error function
  )

  (setvar "cmdecho" 0)

  (cond
     (  (not (ai_notrans)))                        ; transparent not OK
     (  (not (ai_acadapp)))                        ; ACADAPP.EXP xloaded?
     (  (not (setq dcl_id (ai_dcl "ddattdef"))))   ; is .DCL file loaded?
     (T (ai_undo_push)
        (ddattdef_main)                            ; proceed!
        (ai_undo_pop)
     )
  )

  (setq *error* old_error)
  (setvar "cmdecho" old_cmd)
  (princ)
)

;;;---------------------------------------------------------------------------;
(princ "  íuDDATTDEFívñw╕ⁿñJíC")
(princ)