Liren Large Software Subsidy 13/13.iso/p/p024/15.img/AME2.LIB/DDSOLPRM.LSP

Text File | 1992-08-27 | 8.2 KB | 317 lines

;;;   DDSOLPRM.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
;;;
;;;
;;;   ¬⌐Ñ╗ 0.1               9 April 1992
;;;
;;;----------------------------------------------------------------------------;
;;;
;;;   DDSOLPRM.lsp is a dialogue box for AME 2.1.
;;;
;;;   It allows the creation of  AME primitives by picking an icon of
;;;   a box, cylinder, sphere, torus, wedge or cone. A single click
;;;   on the icon sets focus to it and the command is activated by
;;;   clicking on OK. A double click on the icon will also activate
;;;   the command.
;;;
;;;   The baseplane mode for creation of the primitive can also be set
;;;   from this dialogue box. This mode can be enabled or disabled via a
;;;   pair of radio buttons. The mode will grey out if turned off. This
;;;   is the default. When activated, the mode will ungrey and a baseplane
;;;   mode may be selected. The default mode is 3 points.
;;;
;;;   The running osnap dialogue box  can also be called and set from
;;;   this dialogue box. A help function for ddsolprm is also available.
;;;----------------------------------------------------------------------------;

;;; ===================== 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 "DDUCSP"
                  (strcat "ºΣñú¿∞íuAI_UTILS.LSPív└╔«╫;"
                          "\n └╦¼díusupportívÑ╪┐²íC")))

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

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

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


(defun do_help (cmd)
    (if (= (type acad_helpdlg) 'EXSUBR)
      (acad_helpdlg "acad.hlp" cmd)
      (alert "ºΣñú¿∞íu¿DºU╣∩╕▄ív - xload acadapp íC")
    )
    (princ)
)

(defun hi_lite (tile)

     (if (/= last_pic tile)
       (progn
         (mode_tile tile 4)
         (if (/= nil last_pic)
            (mode_tile last_pic 4)
         )
       )
     )

    (setq last_pic tile)
)

(defun start ( / bmods)

   ;initialize the list for baseplane modes
    (setq bmods
     (list "3 Points" "Entity" "Last" "Zaxis"
            "View" "XY Plane" "YZ Plane" "ZX Plane")
    )

    (start_list "bmode")
    (mapcar 'add_list bmods)
    (end_list)

    ;Set tile to value in bm (0 or 1) if not nil
    (if (/= nil bm)
      (cond
         ((= bm 1)
            (set_tile "bspln_on" "1")
            (set_tile "bspln_off" "0")
         )
         ((= bm 0)
            (set_tile "bspln_on" "0")
            (set_tile "bspln_off" "1")
         )
      )
    )

   ;Set bmode to what bspln_on tile is set. Grey or ungrey.
    (if (= 1 (atoi (get_tile "bspln_on")))
      (mode_tile "bmode" 0)
      (mode_tile "bmode" 1)
    )

   (if (/= nil index)
    (set_tile "bmode" (itoa index))
    (setq index (atoi (get_tile "bmode")))
   )

   ;initialize all the icons for icon buttons
   (foreach prim '("Boxpic" "Conepic" "Spherpic" "Cylpic"
                    "Wedgepic" "Torpic")
      (start_image prim)
      (slide_image
        0 0
        (dimx_tile prim)(dimy_tile prim)
        (strcat "acad(" prim ")")

      )
      (end_image)
   )
)

;Grey out popdown selection, if baseplane is turned off.
(defun bm_off()
   (setq bm (atoi (get_tile "bspln_on")))
   (if (= 1 bm)
      (progn (mode_tile "bmode" 0) (bmode))
      (mode_tile "bmode" 1)
   )

)

;Retrieve the index number of selection and set bmod to
;appropriate string

(defun bmode()
   (setq index (atoi (get_tile "bmode")))
   (cond
      ((= 0 index)
         (setq bmod "3")
      )
      ((= 1 index)
         (setq bmod "e")
      )
      ((= 2 index)
         (setq bmod "l")
      )
      ((= 3 index)
         (setq bmod "z")
      )
      ((= 4 index)
         (setq bmod "v")
      )
      ((= 5 index)
         (setq bmod "xy")
      )
      ((= 6 index)
         (setq bmod "yz")
      )
      ((= 7 index)
         (setq bmod "zx")
      )
   )
)

;This is the main function that calls up the dialog
(defun c:ddsolprm (/ ce dcl_id stat old_index old_bm tile last_pic)

   ;; 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)
   (setq old_index index)
   (setq old_bm bm)

   (setq dcl_id (load_dialog "ame.dcl"))

   (if (not (new_dialog "ddsolprm" dcl_id))
       (exit)
   )

   (start)

   (setq stat 0)

   (action_tile "Boxpic" "(hi_lite \"Boxpic\")(setq stat 2)")
   (action_tile "Conepic" "(hi_lite \"Conepic\")(setq stat 3)")
   (action_tile "Spherpic" "(hi_lite \"Spherpic\")(setq stat 4)")
   (action_tile "Cylpic" "(hi_lite \"Cylpic\")(setq stat 5)")
   (action_tile "Wedgepic" "(hi_lite \"Wedgepic\")(setq stat 6)")
   (action_tile "Torpic" "(hi_lite \"Torpic\")(setq stat 7)")

   (action_tile "bspln_on" "(bm_off)")
   (action_tile "bspln_off" "(bm_off)")
   (action_tile "bmode" "(bmode)")

   (action_tile "snapmd" "(c:ddosnap)")

   (action_tile "accept" "(done_dialog stat)")
   (action_tile "cancel" "(setq index old_index)(setq bm old_bm)")
   (action_tile "help" "(do_help \"ddsolprm\")")
   (setq what_next (start_dialog))
   (cond
      ((= what_next 2)
        (if (/= 1 bm)
          (c:solbox)
          (progn
             (if (not solbox)
                 (_autoxload "ame")
             )
           (solbox "b" bmod "*╣∩╜═ªí...*")
          )
        )
      )
      ((= what_next 3)
        (if (/= 1 bm)
          (c:solcone)
          (progn
             (if (not solbox)
                 (_autoxload "ame")
             )
           (solcone "b" bmod "*╣∩╜═ªí...*")
          )
        )
      )
      ((= what_next 4)
        (if (/= 1 bm)
         (c:solsphere)
           (progn
             (if (not solbox)
                 (_autoxload "ame")
             )

           (solsphere "b" bmod "*╣∩╜═ªí...*")
          )
        )
      )
      ((= what_next 5)
        (if (/= 1 bm)
         (c:solcyl)
           (progn
             (if (not solbox)
                 (_autoxload "ame")
             )
           (solcyl "b" bmod "*╣∩╜═ªí...*")
          )
        )
      )
      ((= what_next 6)
        (if (/= 1 bm)
         (c:solwedge)
           (progn
             (if (not solbox)
                 (_autoxload "ame")
             )
           (solwedge "b" bmod "*╣∩╜═ªí...*")
          )
        )
      )
      ((= what_next 7)
        (if (/= 1 bm)
         (c:soltorus)
           (progn
             (if (not solbox)
                 (_autoxload "ame")
             )
           (soltorus "b" bmod "*╣∩╜═ªí...*")
          )
        )
      )
   )

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

(princ "\nC:DDSOLPRM ñw╕ⁿñJ; ÑHíuDDSOLPRMív▒╥░╩½ⁿÑOíC")
(princ)