社区 › AutoLISP/Visual LISP 编程技术 › 【e派】工具箱函数再揭秘及应用实例

cable2004 发表于 2012-7-23 22:52:42

我的心，在等待，永远在等待～～

仲文玉 发表于 2012-7-24 07:09:41

又来观摩，感谢院长

杨如迁 发表于 2012-7-24 08:40:11

支持院长

【KAIXIN】 发表于 2012-7-24 09:01:31

xyp1964 发表于 2012-7-24 22:35:24

lxtj(拉线台阶)

xuexicad1960 发表于 2012-7-25 10:19:07

这里好热闹 ，院长的函数集原来在这里，谢谢院长！

500w008 发表于 2012-7-25 13:31:07

院长 应该做的事情是 去物价局 提高下我们的设计费 不是 写程序了

xyp1964 发表于 2012-7-26 21:58:31

本帖最后由 xyp1964 于 2020-11-19 23:36 编辑

;; ★U序列函数★非常重要的函数

;; ---------------------- UREAL ----------------------------
;;                  实型数输入格式化                     
;; 方式 : (setq no1 (ureal 1 "" "实数" no1))            
(defun ureal (bit kwd msg def / inp)
(if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
)

;; ---------------------- USTR -----------------------------
;;                  字符串输入格式化                     
;; 方式 : (setq txt1 (ustr 1 "字符串" txt1 nil))      
(defun ustr (bit msg def spflag / inp nval)
(if (and def (/= def ""))
    (setq msg (strcat "\n" msg "<" def ">: ")
          inp (getstring msg spflag)
          inp (if (= inp "")
                def
                inp
            )
    )
    (progn
      (setq msg (strcat "\n" msg ": "))
      (if (= bit 1)
      (while (= "" (setq inp (getstring msg spflag))))
      (setq inp (getstring msg spflag))
      )
    )
)
(if inp inp def)
)

;; ---------------------- UDIST ---------------------------
;;                  距离输入格式化                        
;; 方式 : (setq dist1 (udist 1 "" "距离" dist1 '(0 0)))
(defun udist (bit kwd msg def bpt / inp)
(if def
    (setq msg (strcat "\n" msg "<" (rtos def) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (if bpt (getdist msg bpt) (getdist msg)))
(if inp inp def)
)

;; ---------------------- UKWORD ---------------------------
;;                  关键字输入格式化                     
;; 方式 : (setq tx1 (ukword 1 "1 2" "1-任意点/2-中心点" tx1))
(defun ukword (bit kwd msg def / inp)
(if (and def (/= def ""))
    (setq msg (strcat "\n" msg "<" def ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getkword msg))
(if inp inp def)
)

;; ---------------------- UINT -----------------------------
;;                  整型数输入格式化                     
;; 方式 : (setq no1 (uint 1 "" "整数" no1))            
(defun uint (bit kwd msg def / inp)
(if def
    (setq msg (strcat "\n" msg "<" (itoa def) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (getint msg))
(if inp inp def)
)

;; ----------------------- UPOINT ---------------------------
;;                     输入点格式化                        
;; 方式 : (setq pt (upoint 1 "" "点" pt '(0 0)))   
(defun upoint (bit kwd msg def bpt / inp)
(if def
    (setq pts (strcat
                (rtos (car def))
                ", "
                (rtos (cadr def))
                (if (and (caddr def) (= 0 (getvar "flatland")))
                  (strcat ", " (rtos (caddr def)))
                  ""
                )
            )
          msg (strcat "\n" msg "<" pts ">: ")
          bit (* (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (if bpt (getpoint msg bpt)(getpoint msg)))
(if inp inp def)
)

;; ----------------------- UANGLE ---------------------------
;;          格式化输入角度然后返回以弧度表示的角度         
;; 方式 : (setq ang (uangle 1 "" "角度" ang '(0 0)))
(defun uangle (bit kwd msg def bpt / inp)
(if def
    (setq msg (strcat "\n" msg "<" (angtos def) ">: ")
          bit (* (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (if bpt (getangle msg bpt)(getangle msg)))
(if inp inp def)
)

x_s_s_1 发表于 2012-7-26 22:09:40

此贴坚决跟顶

xiaotao 发表于 2012-7-26 22:48:01

算法很不错！

查看完整版本: 【e派】工具箱函数再揭秘及应用实例