Windows 95 v2.4 Fix/W95-v2.4fix.iso/ACADWIN/SUPPORT/DDPTYPE.LSP

Lisp/Scheme | 1995-02-08 | 6.9 KB | 238 lines

; Next available MSG number is    11
; MODULE_ID DDPTYPE_LSP_
;;;
;;;    ddptype.lsp
;;;
;;;    Copyright (C) 1992, 1994 by Autodesk, Inc.
;;;
;;;    Permission to use, copy, modify, and distribute this software
;;;    for any purpose and without fee is hereby granted, provided
;;;    that the above copyright notice appears in all copies and
;;;    that both that copyright notice and the limited warranty and
;;;    restricted rights notice below appear in all supporting
;;;    documentation.
;;;
;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.
;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF
;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.
;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE
;;;    UNINTERRUPTED OR ERROR FREE.
;;;
;;;    Use, duplication, or disclosure by the U.S. Government is subject to
;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer
;;;    Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii)
;;;    (Rights in Technical Data and Computer Software), as applicable.
;;;
;;;.
;;;   C:DDPTYPE - set point style and size dialogue.
;;;
;;;               Uses ddptype.dcl for the dialogue definition.  The
;;;               slide images are in acad.slb.
;;;
;;; ===================== load-time error checking ============================
;;;

  (defun ai_abort (app msg)
     (defun *error* (s)
        (if old_error (setq *error* old_error))
        (princ)
     )
     (if msg
       (alert (strcat " Error en la aplicaci≤n: "
                      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 "DDPTYPE"
                  (strcat "Imposible localizar el archivo AI_UTILS.LSP."
                          "\n Compruebe el directorio de soporte.")))

     (  (eq ;|MSG0|;"failed" (load ;|MSG0|;"ai_utils" "failed"))            ; load it
        (ai_abort "DDPTYPE" "Imposible cargar el archivo AI_UTILS.LSP"))
  )

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

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

(defun ai_ptype_start ( / pt1 pt2)
  (setq ai_pts_lst '("0" "1" "2" "3" "4" "32" "33" "34" "35" "36"
                     "64" "65" "66" "67" "68" "96" "97" "98" "99" "100")
  )
  (foreach pt0 ai_pts_lst
    (setq pt1 (strcat "pdmode" pt0)
          pt2 (getvar "PDMODE")
    )
    (start_image pt1)
    (slide_image
      0 0
      (- (dimx_tile pt1) 1) (- (dimy_tile pt1) 1)
      (strcat "acad(pt" pt0 ")")
    )
    (if (= pt2 (atoi pt0))
      (mode_tile pt1 2)
    )
    (end_image)
  )
)

(defun ai_ptype_set ()
  (ai_chk_pts nil)
  (if ai_pts_do
    (progn
      (if ai_pts0
        (setq ai_pts 0.0)
        (if (= (get_tile ;|MSG0|;"pdsize_r") "1")
          (setq ai_pts (- 0.0 ai_pts))
        )
      )
      (setvar "PDSIZE" ai_pts)
      (setvar "PDMODE" (atoi (substr ai_ptmode 7 3)))
      (done_dialog 1)
    )
  )
)

(defun ai_chk_pts (pts0)
  (cond ((or (= ai_pts nil)
             (<= ai_pts 0.0)
         )
         (set_tile "error" "Entrada no vßlida.")
         (setq ai_pts_do nil)
         (mode_tile ;|MSG0|;"pdsize_value" 2)
        )
        (T
         (set_tile ;|MSG0|;"error" "")
         (setq ai_pts_do T)
         (if pts0
           (setq ai_pts0 nil)
         )
        )
  )
)

(defun ai_pdsize_r ()
  (if ai_pts
    (progn
      (setq ai_pt_do T ai_pts0 nil ai_ptunt 2)
      (set_tile ;|MSG0|;"pdsize_label" "%")
      (set_tile ;|MSG0|;"pdsize_value" (rtos (setq ai_pts (abs ai_pts)) ai_ptunt))
    )
  )
)

(defun ai_pdsize_a ()
  (if ai_pts
    (progn
      (setq ai_pt_do T ai_pts0 nil ai_ptunt (getvar "LUNITS"))
      (if (or (= ai_ptunt 3)
              (= ai_ptunt 4)
          )
        (set_tile ;|MSG0|;"pdsize_label" "")
        (set_tile "pdsize_label" "Unidades")
      )
      (set_tile ;|MSG0|;"pdsize_value" (rtos (setq ai_pts (abs ai_pts)) ai_ptunt))
    )
  )
)

(defun ai_ptype_main (/ globals)
  (ai_ptype_start)
  (mode_tile ai_ptmode 4)
  (if (<= ai_pts 0.0)
    (progn
      (set_tile ;|MSG0|;"pdsize_r" "1")
      (set_tile ;|MSG0|;"pdsize_label" "%")
      (setq ai_ptunt 2)
    )
    (progn
      (set_tile ;|MSG0|;"pdsize_a" "1")
      (setq ai_ptunt (getvar "LUNITS"))
      (if (or (= ai_ptunt 3)
              (= ai_ptunt 4)
          )
        (set_tile ;|MSG0|;"pdsize_label" "")
        (set_tile "pdsize_label" "Unidades")
      )
    )
  )
  (set_tile ;|MSG0|;"pdsize_value" (rtos (setq ai_pts (abs ai_pts)) ai_ptunt))
  (foreach pd0 ai_pts_lst
    (action_tile (strcat "pdmode" pd0)
      ;|MSG0|;"(mode_tile ai_ptmode 4)(setq ai_ptmode $key)(mode_tile ai_ptmode 4)"
    )
  )
  (action_tile ;|MSG0|;"pdsize_value" "(setq ai_pts (distof $value)) (ai_chk_pts T)")
  (action_tile ;|MSG0|;"pdsize_r" "(ai_pdsize_r)")
  (action_tile ;|MSG0|;"pdsize_a" "(ai_pdsize_a)")
  (action_tile ;|MSG0|;"accept" "(ai_ptype_set)")
  (action_tile ;|MSG0|;"help" "(help \"\" \"ddptype\")")
  (start_dialog)
)

(defun c:ddptype (/ app dcl_id old_cmd ai_pts_do ai_ptmode ai_pts
                    ai_pts0 undo_init ai_ptunt)

  ;; 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_trans)))                        ; transparent OK
     (  (not (ai_acadapp)))                      ; ACADAPP.EXP xloaded?
     (  (not (setq dcl_id (ai_dcl ;|MSG0|;"ddptype"))))  ; is .DCL file loaded?
     (T
        (if (/= 1 (logand (getvar "CMDACTIVE") 1)) (ai_undo_push))
        (ddptype_main)
        (if (/= 1 (logand (getvar "CMDACTIVE") 1)) (ai_undo_pop))
     )                          ; proceed!
  )

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

(defun ddptype_main()
  (if (not (new_dialog ;|MSG0|;"ddptype" dcl_id))
    (exit)
  )

  (setq ai_ptmode (strcat "pdmode" (itoa (getvar "PDMODE")))
        ai_pts (getvar "PDSIZE")
  )
  (setvar "CMDECHO" 0)
  (if (= ai_pts 0.0)
    (setq ai_pts -5.0 ai_pts0 T)
  )
  (ai_ptype_main)

  (princ)
)

(princ "  DDPTYPE cargada.  ")
(princ)