[编程交流] Lisp更改全部的Z值

;;==================
;;
;; SZ - Set Z to user input value
;;
;; Changes Elevations of selected entities
;;   (not "Z" values per se)
;; If the Z values are not all the same, no action.
;;
;; Written by Tom Deering
;;
; Rev0 2012-08-08 Initial Code 
;
;
;;==================
;
(defun c:SZ (/ current_layer ss1 s)
; Set Z
(princ "\nSet Z for selected entities...\n")
(setvar "cmdecho" 0)
(setq ss1 (ssget))
(if ss1
(progn
 (setq s (getstring "New Elevation? >"))
 ; Set selected to new elevation
 (command ".change" ss1 "" "P" "E" s "")
 (princ (strcat "\nEntities changed to elevation: " s ))
)
) 
;
(princ)
)
; 
; 
(defun c:SZc (/ current_layer ss1 s)
;Set Z with Change to Current Layer
(setq current_layer (getvar "clayer"))
(princ "\nSet Z for selected entities, w/ Change to curr layer...\n")
(setvar "cmdecho" 0)
(setq ss1 (ssget))
(if ss1
(progn
 (setq s (getstring "New Elevation? >"))
 ; Set selected to new elevation
 (command ".change" ss1 "" "P" "E" s "")
 ;Change to current layer
 (command ".change" ss1 "" "P" "LA" current_layer "")
 (princ (strcat "\nEntities changed to elevation: " s "\nEntities changed to current layer: " current_layer))
)
) 
; 
(princ)
)
; 
;
(defun _SZCx ( elev / current_layer ss1 s)
;To Be Called from Driver Function: (defun c:SZC100 () (_SZCx "100'") (princ) )
(setq current_layer (getvar "clayer"))
(princ (strcat "\nSetting Z to: " elev "(w/change to curr layer)") )
(setvar "cmdecho" 0)
(setq ss1 (ssget))
(if ss1
(progn
 (setq s elev)
 ; Set selected to new elevation
 (command ".change" ss1 "" "P" "E" s "")
 ;Change to current layer
 (command ".change" ss1 "" "P" "LA" current_layer "")
 (princ (strcat "\nEntities changed to elevation: " s "\nEntities changed to current layer: " current_layer))
)
) 
; 
(princ)
)
; 
; 
(defun _SZx ( elev / current_layer ss1 s)
;To Be Called from Driver Function: (defun c:SZC100 () (_SZx "100'") (princ) )
(princ (strcat "\nSetting Z to: " elev "(w/change to curr layer)") )
(setvar "cmdecho" 0)
(setq ss1 (ssget))
(if ss1
(progn
 (setq s elev)
 ; Set selected to new elevation
 (command ".change" ss1 "" "P" "E" s "")
 (princ (strcat "\nEntities changed to elevation: " s ))
)
) 
; 
(princ)
)
; 
; 
; 
;Functions to set to specific elevations
; 
;Set Z - no layer change
(defun c:SZ100 () (_SZx "100'") (princ) )
(defun c:SZ150 () (_SZx "150'") (princ) )
(defun c:SZ200 () (_SZx "200'") (princ) )
; 
;Set Z - Change modified to cuttent layer
(defun c:SZC100 () (_SZCx "100'") (princ) )
(defun c:SZC150 () (_SZCx "150'") (princ) )
(defun c:SZC200 () (_SZCx "200'") (princ) )
; 
; 
; Command to reload this file
(defun c:LSZ ( / s) 
(setvar "cmdecho" 0)
(setq s "SetZ.lsp") 
(if (findfile s)
 (progn
  (load s)
  (princ (strcat "\n" s " reloaded...\n"))
 )
 (princ (strcat "\n" s " NOT reloaded...\n"))
)
;
(princ) 
)
; 
; 
(princ)

(setq s (getstring "New Elevation? >"))
(if (= s nil)(setq s 0.0)) ; if user presses the enter key

(vl-load-com)
(defun c:SELEV () (c:SetElevation))
(defun c:SetElevation (/ *error*)
 (princ "\rSETELEVATION ")
 (defun *error* (msg)
   (if acDoc
     (vla-endundomark acDoc)
   )
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
   )
   (princ)
 )
 ((lambda (acDoc / ss el startPoint endPoint)
    (vla-startundomark acDoc)
    (if
      (and (setq ss (ssget "_:L"))
           (setq el (getreal "\nAmount to add to all elevations: "))
           (setq startPoint (vlax-3d-point '(0. 0. 0.)))
           (setq endPoint (vlax-3d-point (list 0. 0. el)))
      )
       (progn
         (vlax-for x (setq ss (vla-get-activeselectionset acDoc))
           (vla-move x startPoint endPoint)
         )
         (vla-delete ss)
         (*error* nil)
       )
       (cond (ss (*error* "No amount specified"))
             ((*error* "Nothing selected"))
       )
    )
  )
   (vla-get-activedocument (vlax-get-acad-object))
 )
)