SZ-将选定图元设置为指定高程
SZC-将选定图元设置为指定高程，将修改后的图元更改为当前图层
SZ100-将选定图元设置为标高100'
SZ150-将选定图元设置为标高150’
SZ200-将选定图元设置为标高200'
SZc100-将选定图元设置为标高100’，将修改的图元更改为当前图层
SZc150-将选定图元设置为标高150’，将修改的图元更改为当前图层
SZc200-将选定图元设置为标高200’，将修改的图元更改为当前图层
LSZ-重新加载SetZ。lsp if在其中一个支持文件路径中
汤姆
;;==================
;;
;; 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)
注意s=nil，如果用户取消，或者在提示输入s时右键单击，则可以考虑使用错误处理程序来恢复CMDECHO。
谢谢，我知道我略过了错误检测，我会留意它是如何被使用的（分发将非常小）。汤姆 Re s=零
(setq s (getstring "New Elevation? >"))
(if (= s nil)(setq s 0.0)) ; if user presses the enter key
这里有一个有趣的小例子。。。无需操作CMDECHO系统变量，因为此代码使用Visual LISP的Move方法代替Move或Change命令。
(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))
)
)
页:
1
[2]