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

Lisp/Scheme | 1995-02-08 | 15.8 KB | 550 lines

; Next available MSG number is    11
; MODULE_ID DDVPOINT_LSP_
;;;
;;;    ddvpoint.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:DDVPOINT - 3D Viewpoint presets dialog.
;;;
;;;                Uses DDVPOINT.DCL for the dialog definition.
;;;                The slide image is 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 ;|MSG0|;"ai_utils.lsp"))                     ; find it
        (ai_abort "DDVPOINT"
                  (strcat "Imposible localizar el archivo AI_UTILS.LSP."
                          "\n Compruebe el directorio de soporte.")))

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

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

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

(defun ai_ddvp_start ( / image_x image_y image_h slide_x slide_y slide_h)
  (start_image ;|MSG0|;"ddvp_image")
  (slide_image
    0 0
    (- (setq image_x (dimx_tile ;|MSG0|;"ddvp_image")) 1)
    (- (setq image_y (dimy_tile ;|MSG0|;"ddvp_image")) 1)
    ;|MSG0|;"acad(ddvp3d)"
  )
  (end_image)
  (setq
        image_x (float image_x)
        image_y (float image_y)
        slide_x 12.4265
        slide_y 9.0
        image_h (/ image_x image_y)
        slide_h (/ slide_x slide_y)
  )
  (if (< slide_h image_h)
    (setq slide_y image_y
          slide_x (* slide_y slide_h)
    )
    (setq slide_x image_x
          slide_y2 (* slide_y (/ image_x 12.4625))
          image_y2 (/ image_y slide_y2)
          slide_y (* slide_y2 image_y2)

    )
  )
  (setq ai_ddvp_bx (fix (* 0.295 slide_x))
        ai_ddvp_ax (fix (* 0.65 slide_x))
        ai_ddvp_by (fix (* 0.4875 slide_y))
  )
)

(defun ai_rtd (arg)
  (/ (* arg 180.0) pi)
)

(defun ai_dtr (arg)
  (* pi (/ arg 180.0))
)

(defun ai_ang3dv (v1 v2)
  (if (not (equal v1 v2 1e-12))
    (ai_arccos
      (/ (ai_dotp v1 v2)
         (* (sqrt (ai_dotp v1 v1))
            (sqrt (ai_dotp v2 v2))
         )
      )
    )
    (eval '0.0)
  )
)

(defun ai_arccos (ang)
  (if (not (equal ang 1.0 1e-06))
    (if (not (equal ang -1.0 1e-06))
      (atan (sqrt (- 1.0 (expt ang 2.0))) ang)
      (eval pi)
    )
    (eval '0.0)
  )
)

(defun ai_dotp (v1 v2)
  (+
    (* (car v1) (car v2))
    (* (cadr v1) (cadr v2))
    (* (caddr v1) (caddr v2))
  )
)

(defun ai_ddvp_do ()
  (if (or (>= ai_ddvp_b_curr 360.0)
          (< ai_ddvp_b_curr 0.0)
          (null ai_ddvp_b_curr)
      )
    (progn
      (ai_ddvp_drx ai_ddvp_b_last ai_ddvp_bx 0)
      (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 1)
      (mode_tile ;|MSG0|;"ddvp_val_x" 2)
      (set_tile "error" "Angulo desde el eje X no vßlido.")
    )
    (if (or (> ai_ddvp_a_curr 90.0)
            (< ai_ddvp_a_curr -90.0)
            (null ai_ddvp_a_curr)
        )
      (progn
        (ai_ddvp_drx ai_ddvp_a_last ai_ddvp_ax 0)
        (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 1)
        (mode_tile ;|MSG0|;"ddvp_val_xyp" 2)
        (set_tile "error" "Angulo desde el plano XY no vßlido.")
      )
      (done_dialog 1)
    )
  )
)

(defun ai_ddvp_set_a (ang)
  (setq ai_ddvp_a_curr ang)
  (if (or (> ang 90.0)
          (< ang -90.0)
          (null ang)
      )
    (progn
      (ai_ddvp_drx ai_ddvp_a_last ai_ddvp_ax 0)
      (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 1)
      (set_tile "error" "Angulo desde el plano XY no vßlido.")
    )
    (progn
      (set_tile ;|MSG0|;"error" "")
      (ai_ddvp_drx ai_ddvp_a_last ai_ddvp_ax 0)
      (setq ai_ddvp_a_last ai_ddvp_a_curr ai_ddvp_t T)
      (set_tile ;|MSG0|;"ddvp_val_xyp" (rtos ai_ddvp_a_curr 2 1))
      (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 1)
      (ai_ddvp_drx ai_ddvp_a_curr ai_ddvp_ax 7)
    )
  )
)

(defun ai_ddvp_set_b (ang)
  (setq ai_ddvp_b_curr ang)
  (if (or (>= ang 360.0)
          (< ang 0.0)
          (null ang)
      )
    (progn
      (ai_ddvp_drx ai_ddvp_b_last ai_ddvp_bx 0)
      (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 1)
      (set_tile "error" "Angulo desde el eje X no vßlido.")
    )
    (progn
      (set_tile ;|MSG0|;"error" "")
      (ai_ddvp_drx ai_ddvp_b_last ai_ddvp_bx 0)
      (if (= ang 360.0)
        (setq ai_ddvp_b_curr 0.0
              ai_ddvp_a_curr 90.0
              ai_ddvp_p T
              ai_ddvp_b_last ai_ddvp_b_curr
        )
        (setq ai_ddvp_b_last ai_ddvp_b_curr ai_ddvp_t T)
      )
      (set_tile ;|MSG0|;"ddvp_val_x" (rtos ai_ddvp_b_curr 2 1))
      (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 1)
      (ai_ddvp_drx ai_ddvp_b_curr ai_ddvp_bx 7)
    )
  )
)

(defun ai_ddvp_drx (ang x1 col / a x2 y2)
  (setq a (polar (list 0.0 0.0)
                 (- (* 2.0 pi) (ai_dtr ang))
                 25.0
          )
        x2 (+ x1 (fix (car a)))
        y2 (+ ai_ddvp_by (fix (cadr a)))
  )
  (start_image ;|MSG0|;"ddvp_image")
  (vector_image x1 ai_ddvp_by x2 y2 col)
  (end_image)
)

(defun ai_ddvp_image (x y / ang1 ang2 list_xy list_axby list_bxby)
  (setq list_xy (list x y)
        list_axby (list ai_ddvp_ax ai_ddvp_by)
        list_bxby (list ai_ddvp_bx ai_ddvp_by)
  )
  (if (> x (- ai_ddvp_ax 1))
    (progn
      (setq ang1 (ai_rtd (- (* 2.0 pi) (angle list_xy list_axby))))
      (if (< 90.0 ang1)
        (setq ang1 (- ang1 180.0))
      )
      (if (< (distance list_xy list_axby) 40)
        (ai_ddvp_set_a ang1)
        (if (< (distance list_xy list_axby) 84)
          (cond ((= ang1 0.0)
                 (ai_ddvp_set_a 0.0)
                )
                ((< ang1 -72.0)
                 (ai_ddvp_set_a -90.0)
                )
                ((< ang1 -53.0)
                 (ai_ddvp_set_a -60.0)
                )
                ((< ang1 -38.0)
                 (ai_ddvp_set_a -45.0)
                )
                ((< ang1 -20.0)
                 (ai_ddvp_set_a -30.0)
                )
                ((< ang1 -6.0)
                 (ai_ddvp_set_a -10.0)
                )
                ((< ang1 6.0)
                 (ai_ddvp_set_a 0.0)
                )
                ((< ang1 20.0)
                 (ai_ddvp_set_a 10.0)
                )
                ((< ang1 38.0)
                 (ai_ddvp_set_a 30.0)
                )
                ((< ang1 53.0)
                 (ai_ddvp_set_a 45.0)
                )
                ((< ang1 72.0)
                 (ai_ddvp_set_a 60.0)
                )
                (T
                 (ai_ddvp_set_a 90.0)
                )
          )
        )
      )
    )
    (progn
      (setq ang2 (ai_rtd (+ pi (- (* 2.0 pi) (angle list_xy list_bxby)))))
      (if (< 360.0 ang2)
        (setq ang2 (- ang2 360.0))
      )
      (if (< (distance list_xy list_bxby) 40)
        (ai_ddvp_set_b ang2)
        (cond ((= ang2 0.0)
               (ai_ddvp_set_b 0.0)
              )
              ((< ang2 22.5)
               (ai_ddvp_set_b 0.0)
              )
              ((< ang2 67.5)
               (ai_ddvp_set_b 45.0)
              )
              ((< ang2 112.5)
               (ai_ddvp_set_b 90.0)
              )
              ((< ang2 157.5)
               (ai_ddvp_set_b 135.0)
              )
              ((< ang2 202.5)
               (ai_ddvp_set_b 180.0)
              )
              ((< ang2 247.5)
               (ai_ddvp_set_b 225.0)
              )
              ((< ang2 292.5)
               (ai_ddvp_set_b 270.0)
              )
              ((< ang2 337.5)
               (ai_ddvp_set_b 315.0)
              )
              ((< ang2 360.0)
               (ai_ddvp_set_b 0.0)
              )
              (T
               (ai_ddvp_set_b 270.0)
              )
        )
      )
    )
  )
)

(defun ai_ddvp_plan ()
  (ai_ddvp_set_a 90.0)
  (ai_ddvp_set_b 270.0)
)

(defun ai_ddvp_setvdir (a b)
  (list (* (sin (ai_dtr (- 90.0 a))) (cos (ai_dtr b)))
        (* (sin (ai_dtr (- 90.0 a))) (sin (ai_dtr b)))
        (cos (ai_dtr (- 90.0 a)))
  )
)

(defun ai_ddvp_set_abs ()
  (setq ai_ddvp_wv 1)
  (ai_ddvp_drx ai_ddvp_b_curr ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_curr ai_ddvp_ax 0)
  (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 0)
  (setq ai_ddvp_vdir_base (ai_ddvp_fixzero ai_ddvp_vdir_base))
  (ai_ddvp_setang (trans ai_ddvp_vdir_base 1 0 T))
  (setq ai_ddvp_a_base ai_ddvp_a
        ai_ddvp_b_base ai_ddvp_b
  )

  (setq ai_ddvp_vdir_curr
        (ai_ddvp_fixzero
          (trans (ai_ddvp_setvdir ai_ddvp_a_curr ai_ddvp_b_curr) 1 0 T)
        )
  )
  (ai_ddvp_setang ai_ddvp_vdir_curr)
  (setq ai_ddvp_a_curr ai_ddvp_a
        ai_ddvp_b_curr ai_ddvp_b
  )

  (ai_ddvp_set_a ai_ddvp_a_curr)
  (ai_ddvp_set_b ai_ddvp_b_curr)
)


(defun ai_ddvp_set_rel ()
  (setq ai_ddvp_wv 0)
  (ai_ddvp_drx ai_ddvp_b_curr ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_curr ai_ddvp_ax 0)
  (ai_ddvp_drx ai_ddvp_b_base ai_ddvp_bx 0)
  (ai_ddvp_drx ai_ddvp_a_base ai_ddvp_ax 0)
  (setq ai_ddvp_vdir_base (ai_ddvp_fixzero ai_ddvp_vdir_base))
  (ai_ddvp_setang ai_ddvp_vdir_base)
  (setq ai_ddvp_a_base ai_ddvp_a
        ai_ddvp_b_base ai_ddvp_b
  )
  (setq ai_ddvp_vdir_curr
        (ai_ddvp_fixzero
          (trans (ai_ddvp_setvdir ai_ddvp_a_curr ai_ddvp_b_curr) 0 1 T)
        )
  )
  (if ai_ddvp_init
    (setq ai_ddvp_vdir_curr (ai_ddvp_fixzero (trans ai_ddvp_vdir_curr 1 0 T))
          ai_ddvp_init nil
    )
  )
  (ai_ddvp_setang ai_ddvp_vdir_curr)
  (setq ai_ddvp_a_curr ai_ddvp_a
        ai_ddvp_b_curr ai_ddvp_b
  )
  (ai_ddvp_set_a ai_ddvp_a_curr)
  (ai_ddvp_set_b ai_ddvp_b_curr)
)

(defun ai_ddvp_fixzero (vector / vector_x vector_y vector_z)
  (setq vector_x (car vector)
        vector_y (cadr vector)
        vector_z (caddr vector)
  )
  (if (equal vector_x 0.0 1e-06)
    (setq vector_x 0.0)
  )
  (if (equal vector_y 0.0 1e-06)
    (setq vector_y 0.0)
  )
  (if (equal vector_z 0.0 1e-06)
    (setq vector_z 0.0)
  )
  (list vector_x vector_y vector_z)
)

(defun ai_ddvp_setang (viewdir / viewdir_x viewdir_y viewdir_z ai_viewdir)
  (setq ai_viewdir (ai_ddvp_fixzero viewdir)
        ai_ddvp_b (ai_rtd (angle ai_viewdir '(0.0 0.0)))
  )
  (if (equal (list (car ai_viewdir) (cadr ai_viewdir)) '(0.0 0.0) 1e-06)
    (setq ai_ddvp_a 90.0)
    (setq ai_ddvp_a (ai_rtd (ai_ang3dv
                             ai_viewdir
                             (list (car ai_viewdir) (cadr ai_viewdir) 0.0)
                            )
                    )
    )
  )
  (if (< (caddr ai_viewdir) 0.0)
    (setq ai_ddvp_a (- 0.0 ai_ddvp_a))
    (setq ai_ddvp_a (abs ai_ddvp_a))
  )
  (if (>= ai_ddvp_b 180.0)
    (setq ai_ddvp_b (- ai_ddvp_b 180.0))
    (setq ai_ddvp_b (+ ai_ddvp_b 180.0))
  )
  (if (or (= ai_ddvp_a 90.0) (= ai_ddvp_a -90.0))
    (setq ai_ddvp_b 270.0)
  )
)

(defun ai_ddvp_main ()
  (ai_ddvp_start)
  (ai_ddvp_setang ai_ddvp_vdir_base)
  (setq ai_ddvp_a_base ai_ddvp_a
        ai_ddvp_b_base ai_ddvp_b
        ai_ddvp_vdir_curr (ai_ddvp_fixzero
                            (ai_ddvp_setvdir ai_ddvp_a_base ai_ddvp_b_base)
                          )
  )
  (ai_ddvp_setang ai_ddvp_vdir_curr)
  (setq ai_ddvp_a_curr ai_ddvp_a
        ai_ddvp_a_last ai_ddvp_a_curr
        ai_ddvp_b_curr ai_ddvp_b
        ai_ddvp_b_last ai_ddvp_b_curr
  )
  (if (= 0 ai_ddvp_wv)
    (progn
      (ai_ddvp_set_rel)
      (set_tile ;|MSG0|;"ddvp_rel_ucs" "1")
    )
    (ai_ddvp_set_abs)
  )
  (setq ai_ddvp_t nil)
  (set_tile ;|MSG0|;"ddvp_val_x" (rtos ai_ddvp_b_curr 2 1))
  (set_tile ;|MSG0|;"ddvp_val_xyp" (rtos ai_ddvp_a_curr 2 1))
  (action_tile ;|MSG0|;"ddvp_abs_wcs" "(ai_ddvp_set_abs)")
  (action_tile ;|MSG0|;"ddvp_rel_ucs" "(ai_ddvp_set_rel)")
  (action_tile ;|MSG0|;"ddvp_image" "(ai_ddvp_image $x $y)")
  (action_tile ;|MSG0|;"ddvp_val_x" "(ai_ddvp_set_b (distof $value))")
  (action_tile ;|MSG0|;"ddvp_val_xyp" "(ai_ddvp_set_a (distof $value))")
  (action_tile ;|MSG0|;"ddvp_set_plan" "(ai_ddvp_plan)")
  (action_tile ;|MSG0|;"accept" "(ai_ddvp_do)")
  (action_tile ;|MSG0|;"cancel" "(done_dialog 0)")
  (action_tile ;|MSG0|;"help" "(help \"\" \"DDVPOINT\")")
  (if (= (start_dialog) 1)
    (if ai_ddvp_t
      (progn
        (command "._WORLDVIEW" ai_ddvp_wv)
        (command "._VPOINT" "_R"
                 (strcat "<<" (rtos ai_ddvp_b_curr 2))
                 (strcat "<<" (rtos ai_ddvp_a_curr 2))
        )
      )
    )
  )
)

(defun c:ddvpoint ( / ai_ddvp_wv ai_ddvp_vdir_base ai_ddvp_vdir_curr
                      ai_ddvp_bx ai_ddvp_ax ai_ddvp_by ai_ddvp_a_curr
                      ai_ddvp_b_curr ai_ddvp_a_base ai_ddvp_b_base ai_ddvp_p
                      ai_ddvp_t ai_ddvp_init ai_ddvp_a ai_ddvp_b
                      ai_ddvp_a_last ai_ddvp_b_last
                      app dcl_id old_cmd undo_init
                  )

  ;; 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 ;|MSG0|;"ddvpoint"))))  ; is .DCL file loaded?
     (T (ai_undo_push)
        (ddvpoint_main)                           ; proceed!
        (ai_undo_pop)
     )
  )

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

(defun ddvpoint_main()

  (if (and (= 0 (getvar "TILEMODE"))
           (= 1 (getvar "CVPORT"))
      )
    (princ "\n** Comando no permitido en Espacio papel **")
    (progn
      (if (not (new_dialog ;|MSG0|;"ddvpoint" dcl_id))
        (exit)
      )
      (setq ai_ddvp_vdir_base (ai_ddvp_fixzero (getvar "VIEWDIR"))
            ai_ddvp_wv (getvar "WORLDVIEW")
            ai_ddvp_init T
      )
      (ai_ddvp_main)
    )
  )
)

(princ "  DDVPOINT cargada.  ")
(princ)