3d.lsp

Autocad-2005-简体中文-解密版.zip

  (setq l (getdist pt1 (strcat "\nSpecify length of "typ": ")))
  (setq pt3 (list (+ (car pt1) l) (cadr pt1) (caddr pt1)))
  (grdraw pt1 pt3 2)
  (cond 
    ((= typ "wedge")
      (initget 7)                     ;Width can't be 0, neg, or null
      (setq w (getdist pt1 "\nSpecify width of wedge: "))
    )
    (t 
      (initget 7 "Cube")              ;Width can't be 0, neg, or null
      (setq w (getdist pt1 "\nSpecify width of box or [Cube]: "))
      (if (= w "Cube") 
         (setq w l h1 l h2 l)
      )
    )
  )
  (setq pt2 (list (car pt1) (+ (cadr pt1) w) (caddr pt1)))
  (setq pt4 (list (car pt3) (+ (cadr pt3) w) (caddr pt3)))
  (grdraw pt3 pt4 2)
  (grdraw pt4 pt2 2)
  (grdraw pt2 pt1 2)
  (setvar "ORTHOMODE" 0)
  (cond 
    ((= typ "wedge")
      (initget 7)                     ;Height can't be 0, neg, or null
      (setq h1 (getdist pt1 (strcat "\nSpecify height of "typ": ")))
      (setq h2 0.0)
    )
    (t  
      (if (/= h1 l) 
        (progn
          (initget 7)                 ;Height can't be 0, neg, or null
          (setq h1 (getdist pt1 (strcat "\nSpecify height of "typ": ")))
          (setq h2 h1)
        )
      )
    )
  )

  (setq pt5 (list (car pt3) (cadr pt3) (+ (caddr pt3) h2)))
  (setq pt6 (list (car pt4) (cadr pt4) (+ (caddr pt4) h2)))
  (setq pt7 (list (car pt1) (cadr pt1) (+ (caddr pt1) h1)))
  (setq pt8 (list (car pt2) (cadr pt2) (+ (caddr pt2) h1)))
  (command "_.3DMESH" "6" "3" pt5 pt3 pt3 pt7 pt1 pt1 pt8 pt2
            pt1 pt6 pt4 pt3 pt6 pt6 pt5 pt8 pt8 pt7
  )            

  (setq undoit T)
  
  ;; Post special prompt.
  (if (= typ "box")
    (prompt "\nSpecify rotation angle of box about the Z axis or [Reference]: ")
    (prompt "\nSpecify rotation angle of wedge about the Z axis: ")
  )
  ;; Cannot ROTATE on locked layer. Temporarily unlock layer, if need be.
  (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar "clayer"))))))
    (progn 
      (command "_.LAYER" "_UNLOCK" (getvar "clayer") "")
      (setq lockflag 1)
    )
  )  
  
  ;; Issue command.
  (command "_.ROTATE" (entlast) "" pt1)
  
  ;; Allow regular prompting.
  (setvar "cmdecho" 1)
  
  ;; There are a variable number of pauses possible, so keep
  ;; pausing until the ROTATE command completes. 
  (while (= 1 (logand (getvar "cmdactive") 1)) 
    (command pause)
  )
  
  ;; Reset cmdecho.
  (setvar "cmdecho" 0)
  
  ;; ReLock if need be.
  (if (= 1 lockflag)
    (command "._LAYER" "_LOCK" (getvar "clayer") "")
  )
)

;;;--------------------------------------------------------------------------
;;; Draw a pyramid

(defun pyramid (/ pt1 pt2 pt3 pt4 pt5 tp1 tp2 tp3 tp4)
  (initget 17)                        ;3D point can't be null
  (setq pt1 (getpoint "\nSpecify first corner point for base of pyramid: "))
  (initget 17)
  (setq pt2 (getpoint pt1 "\nSpecify second corner point for base of pyramid: "))
  (grdraw pt1 pt2 2)
  (initget 17)
  (setq pt3 (getpoint pt2 "\nSpecify third corner point for base of pyramid: ")) 
  (grdraw pt2 pt3 2)
  (initget 17 "Tetrahedron _Tetrahedron")          ;Choose 3 or 4 point base
  (setq pt4 (getpoint pt3 "\nSpecify fourth corner point for base of pyramid or [Tetrahedron]: ")) 
  (if (= pt4 "Tetrahedron")
    (grdraw pt3 pt1 2)
    (progn
      (grdraw pt3 pt4 2)
      (grdraw pt4 pt1 2)
    )
  )
  (cond 
    ((= pt4 "Tetrahedron")            ;3 point may have top or apex
      (initget 17 "Top _Top")
      (setq pt5 (getpoint "\nSpecify apex point of tetrahedron or [Top]: "))
    )
    (t                                ;4 point may have ridge, top, or apex
      (initget 17 "Top Ridge _Top Ridge") 
      (setq pt5 (getpoint "\nSpecify apex point of pyramid or [Ridge/Top]: "))
    )
  )
  (cond 
    ((= pt5 "Top")                    ;Prompt for top points
      (initget 17)
	  (if (= pt4 "Tetrahedron")
		(setq temp "tetrahedron")
		(setq temp "pyramid")
	  )
      (setq tp1 (getpoint pt1 (strcat "\nSpecify first corner point for top of "temp": ")))
      (grdraw pt1 tp1 2)
      (initget 17)
      (setq tp2 (getpoint pt2 (strcat "\nSpecify second corner point for top of "temp": ")))
      (grdraw tp1 tp2 2)
      (grdraw pt2 tp2 2)
      (initget 17)
      (setq tp3 (getpoint pt3 (strcat "\nSpecify third corner point for top of "temp": ")))
      (grdraw tp2 tp3 2)
      (grdraw pt3 tp3 2)
      (if (/= pt4 "Tetrahedron")
        (progn
          (initget 17)
          (setq tp4 (getpoint pt4 "\nSpecify fourth corner point for top of pyramid: "))
          (grdraw tp3 tp4 2)
          (grdraw pt4 tp4 2)
        )
      )
    )
    ((= pt5 "Ridge")                  ;Prompt for ridge points
      (grdraw pt4 pt1 2 -1)
      (initget 17)                
      (setq tp1 (getpoint "\nSpecify first ridge end point of pyramid: "))
      (grdraw pt4 pt1 2)
      (grdraw pt1 tp1 2)
      (grdraw pt4 tp1 2)
      (grdraw pt3 pt2 2 -1)
      (initget 17)                
      (setq tp2 (getpoint tp1 "\nSpecify second ridge end point of pyramid: "))
      (grdraw pt2 tp2 2)
      (grdraw pt3 tp2 2)
    )
    (t 
      (setq tp1 pt5)                  ;Must be apex
      (setq tp2 tp1)
    )
  )

  (cond 
    ((and (/= pt4 "Tetrahedron")(/= pt5 "Top"))
      (command "_.3DMESH" "4" "4" tp1 tp1 tp2 tp2 tp1 pt4 pt3 tp2 
                tp1 pt1 pt2 tp2 tp1 tp1 tp2 tp2
      )
    )
    ((and (/= pt4 "Tetrahedron")(= pt5 "Top"))
      (command "_.3DMESH" "5" "4" tp1 tp1 tp2 tp2 tp4 tp4 tp3 tp3
                tp4 pt4 pt3 tp3 tp1 pt1 pt2 tp2 tp1 tp1 tp2 tp2
      )
    )
    ((and (= pt4 "Tetrahedron")(/= pt5 "Top"))
      (command "_.3DMESH" "5" "2" tp1 pt2 pt3 pt2 pt3 pt1 tp1 pt1 
                tp1 pt2
      )
    )
    (t 
      (command "_.3DMESH" "4" "4" pt3 pt1 tp1 tp3 pt2 pt2 tp2 tp2
                pt3 pt3 tp3 tp3 pt3 pt1 tp1 tp3
      )
    )
  )     
)

;;;------------------------------------------------------------------------
;;; Draw a mesh
;;;
;;; Given a starting and an ending point, this function finds the next
;;; set of points in the N direction.

(defun next-n (pt1 pt2 / xinc yinc zinc loop pt)
  (setq xinc (/ (- (car pt2) (car pt1)) (1- n)))
  (setq yinc (/ (- (cadr pt2) (cadr pt1)) (1- n)))
  (setq zinc (/ (- (caddr pt2) (caddr pt1)) (1- n)))
  (setq loop (1- n))
  (setq pt pt1)
  (while (> loop 0)
    (setq pt (list (+ (car pt) xinc) (+ (cadr pt) yinc) (+ (caddr pt) zinc)))
    (command pt)
    (setq loop (1- loop))
  )
)

;;; This function finds the next point in the M direction.

(defun next-m (pt1 pt2 loop / xinc yinc zinc)
  (if (/= m loop)
    (progn
      (setq xinc (/ (- (car pt2) (car pt1)) (- m loop)))
      (setq yinc (/ (- (cadr pt2) (cadr pt1)) (- m loop)))
      (setq zinc (/ (- (caddr pt2) (caddr pt1)) (- m loop)))
    )
    (progn
      (setq xinc 0)
      (setq yinc 0)
      (setq zinc 0)
    )
  )
  (setq pt1 (list (+ (car pt1) xinc) (+ (cadr pt1) yinc) (+ (caddr pt1) zinc)))
)

(defun mesh (/ c1 c2 c3 c4 m n loop)
  (setq m 0 n 0)                      ;Initialize variables
  (initget 17)                     
  (setq c1 (getpoint "\nSpecify first corner point of mesh: "))
  (initget 17)                     
  (setq c2 (getpoint c1 "\nSpecify second corner point of mesh: "))
  (grdraw c1 c2 2)
  (initget 17)                     
  (setq c3 (getpoint c2 "\nSpecify third corner point of mesh: "))
  (grdraw c2 c3 2)
  (initget 17)                     
  (setq c4 (getpoint c3 "\nSpecify fourth corner point of mesh: "))
  (grdraw c3 c4 2)
  (grdraw c4 c1 2 1)
  (while (or (< m 2) (> m 256))
    (initget 7)                     
    (setq m (getint "\nEnter mesh size in the M direction: "))
    (if (or (< m 2) (> m 256)) 
      (princ "\nValue must be between 2 and 256.")
    )
  )
  (grdraw c4 c1 2)
  (grdraw c1 c2 2 1)
  (while (or (< n 2) (> n 256))
    (initget 7)                     
    (setq n (getint "\nEnter mesh size in the N direction: "))
    (if (or (< n 2) (> n 256)) 
      (princ "\nValue must be between 2 and 256.")
    )
  )
  (setvar "osmode" 0)                 ;Turn OSMODE off
  (setvar "blipmode" 0)               ;Turn BLIPMODE off
  (command "_.3DMESH" m n)
  (command c1)
  (setq loop 1)
  (next-n c1 c2)
  (while (< loop m)
    (setq c1 (next-m c1 c4 loop)) 
    (setq c2 (next-m c2 c3 loop))
    (command c1)
    (next-n c1 c2)
    (setq loop (1+ loop))
  )
)

;;;--------------------------------------------------------------------------
;;; Internal error handler

(defun 3derr (s)                      ;If an error (such as CTRL-C) occurs
                                      ;while this command is active...
  (ai_setCmdEcho 0)
  
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (moder)                             ;Restore saved modes
  (command "_.REDRAWALL") 
  (if undoit
    (progn
      (command)
      (command "_.UNDO" "_e")            ;Terminate undo group
      (princ "\nundoing...") 
      (command "_.U")                   ;Erase partially drawn shape
    )
    (command "_.UNDO" "_e")               
  )
  (ai_undo_off)
  ; Restore CMDECHO without undo recording 
  (ai_setCmdEcho oce)
  (setq *error* olderr)               ;Restore old *error* handler
  (princ)
)

;;;--------------------------------------------------------------------------
;;;
;;; Main program.  Draws 3D object specified by "key" argument.
;;; If "key" is nil, asks which object is desired.

(defun 3d (key / olderr undo_setting)
  (if m:err                           ;If called from the menu
    (setq olderr m:err *error* 3derr) ;save the menus trapped *error*
    (setq olderr *error* *error* 3derr)
  )
  (setq undoit nil)
  (setq oce (getvar "cmdecho"))
  ; Set CMDECHO without undo recording 
  (ai_setCmdEcho 0)

  (ai_undo_on)                       ; Turn UNDO on
  (command "_.UNDO" "_group")

  (modes '("BLIPMODE" "ORTHOMODE" "OSMODE"
           "SURFTAB1" "SURFTAB2" "UCSFOLLOW"))

  (setvar "UCSFOLLOW" 0)
  (setvar "OSMODE" 0)
  (if (null key)
    (progn
      (initget "Box Cone DIsh DOme Mesh Pyramid Sphere Torus Wedge")
      (setq key (getkword 
        "\nEnter an option\n[Box/Cone/DIsh/DOme/Mesh/Pyramid/Sphere/Torus/Wedge]: "))
    )
  )
  (cond 
    ((= key "Box")     (boxwed  "box")   ) 
    ((= key "Cone")    (cone)            )
    ((= key "DIsh")    (spheres "dish")  )
    ((= key "DOme")    (spheres "dome")  )
    ((= key "Mesh")    (mesh)            )
    ((= key "Pyramid") (pyramid)         )
    ((= key "Sphere")  (spheres "sphere"))
    ((= key "Torus")   (torus)           )
    ((= key "Wedge")   (boxwed  "wedge") )
    (T nil)                           ;Null reply?  Just exit
  )
  (moder)                             ;Restore saved modes
  (command "_.REDRAWALL")
  (command "_.UNDO" "_E")             ;Terminate undo group

  (ai_undo_off)                       ; Return UNDO to initial state.

  ; Restore saved CMDECHO value without undo recording
  (ai_setCmdEcho oce)
  (setq *error* olderr)               ;Restore old *error* handler
  (princ)
)

;;;--------------------------------------------------------------------------
;;; C: function definitions

(defun C:AI_BOX ()     (3d "Box"))
(defun C:AI_CONE ()    (3d "Cone"))
(defun C:AI_DISH ()    (3d "DIsh"))
(defun C:AI_DOME ()    (3d "DOme"))
(defun C:AI_MESH ()    (3d "Mesh"))
(defun C:AI_PYRAMID () (3d "Pyramid"))
(defun C:AI_SPHERE ()  (3d "Sphere"))
(defun C:AI_TORUS ()   (3d "Torus"))
(defun C:AI_WEDGE ()   (3d "Wedge"))
(defun C:3D ()         (3d nil))

(princ "  3D Objects loaded.")
(princ)