u系列函数

taner · 发表于 2013-6-16 21:45:43

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;;http://www.paracadd.com/lisp/uutils.lsp
;These functions are freeware courtesy of the author's of "Inside AutoLisp"
;for rel. 10 published by New Riders Publications. This credit must
;accompany all copies of this function.
;* UANGLE User interface angle function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default real in rads is
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil
;* for none).
;*
(defun uangle (bit kwd msg def bpt / inp)
(if def
(setq msg (strcat "\n" msg " <" (if(eq(type def)'STR)def(angtos def)) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp
(if bpt
(getangle msg bpt)
(getangle msg)
) )
(if inp inp def)
);defun
;*
(princ)
;*
;* UDIST User interface function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added. BPT is base point (nil for none).
;*
(defun udist (bit kwd msg def bpt / inp)
(if def
(setq msg (strcat "\n" msg " <" (rtos def) ">: ")
bit (* 2 (fix (/ bit 2)))
);setq
(setq msg (strcat "\n" msg ": "))
);if
(initget bit kwd)
(setq inp
(if bpt
(getdist msg bpt)
(getdist msg)
) );setq&if
(if inp inp def)
);defun
;*
(princ)
;*
;* UINT User interface function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added.
;*
(defun uint (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg " <" (rtos def 2 0) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
);if
(initget bit kwd)
(setq inp (getint msg))
(if inp inp def)
);defun
;*
(princ)
;*
;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default string is added
;* as <DEF> (nil or "" for none), and a : is added.
;*
(defun ukword (bit kwd msg def / inp)
(if (and def (/= def ""))
(setq msg (strcat "\n" msg " <" def ">: ")
bit (* 2 (fix (/ bit 2)))
);setq
);if
(initget bit kwd)
(setq inp (getkword msg))
(if inp inp def)
);defun
;*
;* UPOINT User interface point function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default point variable
;* is added as <DEF> (nil for none), and a : is added. BPT is base point
;* (nil for none).
;*
(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)))
""
) );if&strcat
msg (strcat "\n" msg " <" pts ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
);if a default was supplied
(initget bit kwd)
(setq inp
(if bpt
(getpoint msg bpt)
(getpoint msg)
) );setq&if
(if inp inp def)
);defun
;*
(princ)
;*
;* UREAL User interface real function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added.
;*
(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 ": "))
);if
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
);defun
;*
(princ)
;*
;* USTR User interface string
;* If BIT=1 no null "" input allowed, 0 for none, BIT ignored if DEF present.
;* MSG is the prompt string, to which a default string is added as <DEF> (nil
;* or "" for none), and a : is added. If SPFLAG T, spaces are allowed in
;* string.
;*
(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)
);setq
(progn
(setq msg (strcat "\n" msg ": "))
(if (= bit 1)
(while (= "" (setq inp (getstring msg spflag))))
(setq inp (getstring msg spflag))
) );progn&if
);if
inp
);defun
;*
(princ)
;*

;;;http://www.paracadd.com/lisp/uutils.lsp 
;These functions are freeware courtesy of the author's of "Inside AutoLisp" 
;for rel. 10 published by New Riders Publications.  This credit must 
;accompany all copies of this function. 
 
;* UANGLE User interface angle function 
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as 
;* for INITGET. MSG is the prompt string, to which a default real in rads is 
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil 
;* for none). 
;* 
(defun uangle (bit kwd msg def bpt / inp) 
  (if def 
    (setq msg (strcat "\n" msg " <" (if(eq(type def)'STR)def(angtos def)) ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    ) 
    (setq msg (strcat "\n" msg ": ")) 
  ) 
  (initget bit kwd) 
  (setq inp 
    (if bpt 
       (getangle msg bpt) 
       (getangle msg) 
  ) ) 
  (if inp inp def) 
);defun 
;* 
(princ) 
;* 
;* UDIST User interface function 
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. 
;* MSG is the prompt string, to which a default real is added as <DEF> (nil 
;* for none), and a : is added. BPT is base point (nil for none). 
;* 
(defun udist (bit kwd msg def bpt / inp) 
  (if def 
    (setq msg (strcat "\n" msg " <" (rtos def) ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    );setq 
    (setq msg (strcat "\n" msg ": ")) 
  );if 
  (initget bit kwd) 
  (setq inp 
    (if bpt 
       (getdist msg bpt) 
       (getdist msg) 
  ) );setq&if 
  (if inp inp def) 
);defun 
;* 
(princ) 
;* 
;* UINT User interface function 
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. 
;* MSG is the prompt string, to which a default real is added as <DEF> (nil 
;* for none), and a : is added. 
;* 
(defun uint (bit kwd msg def / inp) 
  (if def 
    (setq msg (strcat "\n" msg " <" (rtos def 2 0) ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    ) 
    (setq msg (strcat "\n" msg ": ")) 
  );if 
  (initget bit kwd) 
  (setq inp (getint msg)) 
  (if inp inp def) 
);defun 
;* 
(princ) 
;* 
;* UKWORD User key word. DEF, if any, must match one of the KWD strings 
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as 
;* for INITGET. MSG is the prompt string, to which a default string is added 
;* as <DEF> (nil or "" for none), and a : is added. 
;* 
(defun ukword (bit kwd msg def / inp) 
  (if (and def (/= def "")) 
    (setq msg (strcat "\n" msg " <" def ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    );setq 
  );if 
  (initget bit kwd) 
  (setq inp (getkword msg)) 
  (if inp inp def) 
);defun 
;* 
;* UPOINT User interface point function 
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as 
;* for INITGET. MSG is the prompt string, to which a default point variable 
;* is added as <DEF> (nil for none), and a : is added. BPT is base point 
;* (nil for none). 
;* 
(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))) 
                  "" 
              ) );if&strcat 
          msg (strcat "\n" msg " <" pts ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    ) 
    (setq msg (strcat "\n" msg ": ")) 
  );if a default was supplied 
  (initget bit kwd) 
  (setq inp 
    (if bpt 
       (getpoint msg bpt) 
       (getpoint msg) 
  ) );setq&if 
  (if inp inp def) 
);defun 
;* 
(princ) 
;* 
;* UREAL User interface real function 
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. 
;* MSG is the prompt string, to which a default real is added as <DEF> (nil 
;* for none), and a : is added. 
;* 
(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 ": ")) 
  );if 
  (initget bit kwd) 
  (setq inp (getreal msg)) 
  (if inp inp def) 
);defun 
;* 
(princ) 
;* 
;* USTR User interface string 
;* If BIT=1 no null "" input allowed, 0 for none, BIT ignored if DEF present. 
;* MSG is the prompt string, to which a default string is added as <DEF> (nil 
;* or "" for none), and a : is added. If SPFLAG T, spaces are allowed in 
;* string. 
;* 
(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) 
    );setq 
    (progn 
      (setq msg (strcat "\n" msg ": ")) 
      (if (= bit 1) 
          (while (= "" (setq inp (getstring msg spflag)))) 
          (setq inp (getstring msg spflag)) 
      ) );progn&if 
    );if 
    inp 
);defun 
;* 
(princ) 
;*

cable2004 · 发表于 2013-6-16 22:34:55

不错的源码！

Free-Lancer · 发表于 2013-6-16 22:35:32

院长的库里是不是也用了这些函数？！

taner · 发表于 2013-6-16 22:45:39

当年院长这几个函数，密码输对了，有个指令可以输出源码。我猜密码是XDCAD，还真让我猜中了，所以我很早就有了这几个函数的源码，后来找到了这几个函数的老巢。

XDSoft · 发表于 2013-6-16 23:06:58

taner 发表于 2013-6-16 22:45
当年院长这几个函数，密码输对了，有个指令可以输出源码。我猜密码是XDCAD，还真让我猜中了，所以我很早就 ...

天才，你。成译码专家了，希望提供更多更好的函数来。

XDSoft · 发表于 2013-6-16 23:12:45

taner 发表于 2013-6-16 22:45
当年院长这几个函数，密码输对了，有个指令可以输出源码。我猜密码是XDCAD，还真让我猜中了，所以我很早就 ...

XDRX_API FOR 2014 , 密码给你发消息了，查看下。

GTJ116600 · 发表于 2013-6-17 06:40:56

是挺不错的源码，呵呵，就是不知道做什么用的{:soso_e100:}

xshrimp · 发表于 2013-6-17 08:17:25

本帖最后由 xshrimp 于 2013-6-17 08:20 编辑

不过这个好像不是最新版的.最新的作者加了.
October 19, 2004 added function chkkwds (see description at end of file)

;*
;;;This function alerts the user when keywords containing invalid characters are used and it will
;;;identify and disable the offending keywords leaving the remaining keywords enabled.
(DEFUN chkkwds (kwd /)
(SETQ invalidcharlst (LIST "_" "!" "@" "$" "%" "^" "&" "`" "(" ")" "*" "+" "=" "<" ">"))
(IF (OR (WCMATCH kwd "*_*")
(WCMATCH kwd "*`!*")
(WCMATCH kwd "*`@*")
(WCMATCH kwd "*`$*")
(WCMATCH kwd "*`%*")
(WCMATCH kwd "*`^*")
(WCMATCH kwd "*`&*")
(WCMATCH kwd "*`**")
(WCMATCH kwd "*(*")
(WCMATCH kwd "*)*")
(WCMATCH kwd "*+*")
(WCMATCH kwd "*=*")
(WCMATCH kwd "*<*")
(WCMATCH kwd "*>*")
) ;_ end of OR
(PROGN (PRINC "\nInvalid characters in keyword specification!")
(PRINC "\nAttempting to disable invalid keywords.")
(PRINC)
(SETQ stripkwd kwd
kwdcnt 1
charposlst NIL
) ;_ end of setq
(WHILE (AND stripkwd (<= kwdcnt (STRLEN kwd)))
(IF (MEMBER (SUBSTR stripkwd kwdcnt 1) invalidcharlst)
(IF charposlst
(SETQ charposlst (APPEND charposlst (LIST kwdcnt)))
(SETQ charposlst (LIST kwdcnt))
) ;_ end of if
) ;_ end of if
(SETQ kwdcnt (1+ kwdcnt))
) ;_ end of while
(FOREACH n charposlst
(COND ((OR (WCMATCH (SUBSTR kwd 1 n) "* *") (WCMATCH (SUBSTR kwd n) "* *"))
(SETQ inicnt n)
(WHILE (/= (SUBSTR kwd (1- inicnt) 1) " ") (SETQ inicnt (1- inicnt)))
(SETQ endcnt inicnt)
(WHILE (AND (/= endcnt (1- (STRLEN kwd))) (/= (SUBSTR kwd (1+ endcnt) 1) " "))
(SETQ endcnt (1+ endcnt))
) ;_ end of WHILE
(SETQ remcnt inicnt
remend endcnt
) ;_ end of SETQ
(WHILE (<= inicnt endcnt)
(SETQ kwd (STRCAT (SUBSTR kwd 1 (1- inicnt)) " " (SUBSTR kwd (1+ inicnt))))
(SETQ inicnt (1+ inicnt))
) ;_ end of WHILE
(PRINC (STRCAT "\nKeyword " (SUBSTR stripkwd remcnt (- endcnt remcnt -1)) " is disabled! "))
(PRINC)
)
) ;_ end of COND
) ;_ end of FOREACH
(PRINC "\nOmit invalid keyword characters at source to enable these keywords. ")
(PRINC)
) ;_ end of PROGN
) ;_ end of IF
)
;;;---------------------------------------------------------
;;;U系列函数.格式化输入.
;;;October 19, 2004 added function chkkwds (see description at end of file)
;* UANGLE User interface angle function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default real in rads is
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil
;* for none).
;*
;(defun ui-get-input (str default) ;;/*{{{*/
; (cond
; ((getint (strcat str "<" (itoa default) "> " )))
; (default)
; )
;)
(defun uangle (bit kwd msg def bpt / inp)
(chkkwds kwd)
(if def
(setq msg (strcat "\n" msg " <" (if(eq(type def)'STR) def (angtos def)) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp
(if bpt
(getangle msg bpt)
(getangle msg)
) )
(if inp inp def)
)
;*
;* UDIST User interface function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added. BPT is base point (nil for none).
;*
(defun udist (bit kwd msg def bpt / inp)
(chkkwds kwd)
(if def
(setq msg (strcat "\n" msg " <" (rtos def) ">: ")
bit (* 2 (fix (/ bit 2)))
);setq
(setq msg (strcat "\n" msg ": "))
);if
(initget bit kwd)
(setq inp
(if bpt
(getdist msg bpt)
(getdist msg)
) );setq&if
(if inp inp def)
)
;*
;* UINT User interface function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added.
;*
(defun uint (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL) (rtos def 2 0)(if (eq (type def) 'INT) (itoa def) def)) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
);if
(initget bit kwd)
(setq inp (getint msg))
(if inp inp def)
)
;*
;;;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;;;* for INITGET. MSG is the prompt string, to which a default string is added
;;;* as <DEF> (nil or "" for none), and a : is added.
;;;*
(DEFUN ukword (bit kwd msg def / inp)
(chkkwds kwd)
(IF (AND def (/= def ""))
(SETQ msg (STRCAT "\n" msg " <" def ">: ")
bit (* 2 (FIX (/ bit 2)))
);setq
);if
(INITGET bit kwd)
(SETQ inp (GETKWORD msg))
(IF inp
inp
def
) ;_ end of if
)
;*
;* UPOINT User interface point function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default point variable
;* is added as <DEF> (nil for none), and a : is added. BPT is base point
;* (nil for none).
;*
(defun upoint (bit kwd msg def bpt / inp)
(if def
(if (eq (type def) 'STR)
(setq msg (strcat "\n" msg " <" def ">:")
bit (* 2 (fix (/ bit 2)))
)
(progn
(setq pts (strcat
(rtos (car def)) "," (rtos (cadr def))
(if
(and (caddr def) (= 0 (getvar "FLATLAND")))
(strcat "," (rtos (caddr def)))
""
) );if&strcat
msg (strcat "\n" msg " <" pts ">: ")
bit (* 2 (fix (/ bit 2)))
)
)
)
(setq msg (strcat "\n" msg ": "))
);if a default was supplied
(initget bit kwd)
(setq inp
(if bpt
(getpoint msg bpt)
(getpoint msg)
) );setq&if
(if inp inp def)
)
;* UREAL User interface real function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added.
;*
(defun ureal (bit kwd msg def / inp)
(if def
(setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL)(rtos def 2)(if (eq (type def) 'INT)(itoa def)def)) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
);if
(initget bit kwd)
(setq inp (getreal msg))
(if inp inp def)
)
;;; USTR User interface string If BIT=1 no null "" input allowed, 0 for none, BIT
;;; ignored if DEF present. MSG is the prompt string, to which a default string
;;; is added as <DEF> (nil or "" for none), and a : is added. If SPFLAG T, spaces
;;; are allowed in
;;; string.
;;;
;;;> Author: Henry C. Francis
;;;> 425 N. Ashe St.
;;;> Southern Pines, NC 28387
;;;> [url]http://paracadd.com[/url]
;;;
;;;> COPYRIGHT: 1-14-98
;;;> EDITED: 03-02-2001
;;;
(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
) ;_ end of if
) ;_ end of setq
(PROGN
(SETQ msg (STRCAT "\n" msg ": "))
(IF (= bit 1)
(WHILE (= "" (SETQ inp (GETSTRING msg spflag))))
(SETQ inp (GETSTRING msg spflag))
) ;_ end of if
) ;_ end of progn
) ;_ end of if
inp
)

;* 
;;;This function alerts the user when keywords containing invalid characters are used and it will 
;;;identify and disable the offending keywords leaving the remaining keywords enabled. 
(DEFUN chkkwds (kwd /) 
  (SETQ invalidcharlst (LIST "_" "!" "@" "$" "%" "^" "&" "`" "(" ")" "*" "+" "=" "<" ">")) 
  (IF (OR (WCMATCH kwd "*_*")          
          (WCMATCH kwd "*`!*") 
          (WCMATCH kwd "*`@*") 
          (WCMATCH kwd "*`$*") 
          (WCMATCH kwd "*`%*") 
          (WCMATCH kwd "*`^*") 
          (WCMATCH kwd "*`&*") 
          (WCMATCH kwd "*`**") 
          (WCMATCH kwd "*(*") 
          (WCMATCH kwd "*)*") 
          (WCMATCH kwd "*+*") 
          (WCMATCH kwd "*=*") 
          (WCMATCH kwd "*<*") 
          (WCMATCH kwd "*>*") 
      ) ;_ end of OR 
    (PROGN (PRINC "\nInvalid characters in keyword specification!") 
           (PRINC "\nAttempting to disable invalid keywords.") 
           (PRINC) 
           (SETQ stripkwd kwd 
                 kwdcnt 1 
                 charposlst NIL 
           ) ;_ end of setq 
           (WHILE (AND stripkwd (<= kwdcnt (STRLEN kwd))) 
             (IF (MEMBER (SUBSTR stripkwd kwdcnt 1) invalidcharlst) 
               (IF charposlst 
                 (SETQ charposlst (APPEND charposlst (LIST kwdcnt))) 
                 (SETQ charposlst (LIST kwdcnt)) 
               ) ;_ end of if 
             ) ;_ end of if 
             (SETQ kwdcnt (1+ kwdcnt)) 
           ) ;_ end of while 
           (FOREACH n charposlst 
             (COND ((OR (WCMATCH (SUBSTR kwd 1 n) "* *") (WCMATCH (SUBSTR kwd n) "* *")) 
                    (SETQ inicnt n) 
                    (WHILE (/= (SUBSTR kwd (1- inicnt) 1) " ") (SETQ inicnt (1- inicnt))) 
                    (SETQ endcnt inicnt) 
                    (WHILE (AND (/= endcnt (1- (STRLEN kwd))) (/= (SUBSTR kwd (1+ endcnt) 1) " ")) 
                      (SETQ endcnt (1+ endcnt)) 
                    ) ;_ end of WHILE 
                    (SETQ remcnt inicnt 
                          remend endcnt 
                    ) ;_ end of SETQ 
                    (WHILE (<= inicnt endcnt) 
                      (SETQ kwd (STRCAT (SUBSTR kwd 1 (1- inicnt)) " " (SUBSTR kwd (1+ inicnt)))) 
                      (SETQ inicnt (1+ inicnt)) 
                    ) ;_ end of WHILE 
                    (PRINC (STRCAT "\nKeyword " (SUBSTR stripkwd remcnt (- endcnt remcnt -1)) " is disabled! ")) 
                    (PRINC) 
                   ) 
             ) ;_ end of COND 
           ) ;_ end of FOREACH 
           (PRINC "\nOmit invalid keyword characters at source to enable these keywords. ") 
           (PRINC) 
    ) ;_ end of PROGN 
  ) ;_ end of IF 
) 
 
 
;;;--------------------------------------------------------- 
;;;U系列函数.格式化输入. 
;;;October 19, 2004 added function chkkwds (see description at end of file) 
 
;* UANGLE User interface angle function 
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as 
;* for INITGET. MSG is the prompt string, to which a default real in rads is 
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil 
;* for none). 
;* 
;(defun ui-get-input (str default)       ;;/*{{{*/ 
;    (cond 
;      ((getint (strcat str "<" (itoa default) "> " ))) 
;      (default) 
;    ) 
;) 
(defun uangle (bit kwd msg def bpt / inp) 
  (chkkwds kwd) 
  (if def 
    (setq msg (strcat "\n" msg " <" (if(eq(type def)'STR) def (angtos def)) ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    ) 
    (setq msg (strcat "\n" msg ": ")) 
  ) 
  (initget bit kwd) 
  (setq inp 
    (if bpt 
       (getangle msg bpt) 
       (getangle msg) 
  ) ) 
  (if inp inp def) 
) 
 
;* 
;* UDIST User interface function 
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. 
;* MSG is the prompt string, to which a default real is added as <DEF> (nil 
;* for none), and a : is added. BPT is base point (nil for none). 
;* 
(defun udist (bit kwd msg def bpt / inp) 
  (chkkwds kwd) 
  (if def 
    (setq msg (strcat "\n" msg " <" (rtos def) ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    );setq 
    (setq msg (strcat "\n" msg ": ")) 
  );if 
  (initget bit kwd) 
  (setq inp 
    (if bpt 
       (getdist msg bpt) 
       (getdist msg) 
  ) );setq&if 
  (if inp inp def) 
) 
 
;* 
;* UINT User interface function 
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. 
;* MSG is the prompt string, to which a default real is added as <DEF> (nil 
;* for none), and a : is added. 
;* 
(defun uint (bit kwd msg def / inp) 
  (if def 
    (setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL) (rtos def 2 0)(if (eq (type def) 'INT) (itoa def) def)) ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    ) 
    (setq msg (strcat "\n" msg ": ")) 
  );if 
  (initget bit kwd) 
  (setq inp (getint msg)) 
  (if inp inp def) 
) 
 
;* 
;;;* UKWORD User key word. DEF, if any, must match one of the KWD strings 
;;;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as 
;;;* for INITGET. MSG is the prompt string, to which a default string is added 
;;;* as <DEF> (nil or "" for none), and a : is added. 
;;;* 
(DEFUN ukword (bit kwd msg def / inp) 
  (chkkwds kwd) 
  (IF (AND def (/= def "")) 
    (SETQ msg (STRCAT "\n" msg " <" def ">: ") 
          bit (* 2 (FIX (/ bit 2))) 
    );setq 
  );if 
  (INITGET bit kwd) 
  (SETQ inp (GETKWORD msg)) 
  (IF inp 
    inp 
    def 
  ) ;_ end of if 
) 
 
;* 
;* UPOINT User interface point function 
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as 
;* for INITGET. MSG is the prompt string, to which a default point variable 
;* is added as <DEF> (nil for none), and a : is added. BPT is base point 
;* (nil for none). 
;* 
(defun upoint (bit kwd msg def bpt / inp) 
  (if def 
    (if (eq (type def) 'STR) 
      (setq msg (strcat "\n" msg " <" def ">:") 
            bit (* 2 (fix (/ bit 2))) 
      ) 
      (progn 
        (setq pts (strcat 
                    (rtos (car def)) "," (rtos (cadr def)) 
                    (if 
                      (and (caddr def) (= 0 (getvar "FLATLAND"))) 
                      (strcat "," (rtos (caddr def))) 
                      "" 
                  ) );if&strcat 
              msg (strcat "\n" msg " <" pts ">: ") 
              bit (* 2 (fix (/ bit 2))) 
        ) 
      ) 
    ) 
    (setq msg (strcat "\n" msg ": ")) 
  );if a default was supplied 
  (initget bit kwd) 
  (setq inp 
    (if bpt 
       (getpoint msg bpt) 
       (getpoint msg) 
  ) );setq&if 
  (if inp inp def) 
) 
 
;* UREAL User interface real function 
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. 
;* MSG is the prompt string, to which a default real is added as <DEF> (nil 
;* for none), and a : is added. 
;* 
(defun ureal (bit kwd msg def / inp) 
  (if def 
    (setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL)(rtos def 2)(if (eq (type def) 'INT)(itoa def)def)) ">: ") 
          bit (* 2 (fix (/ bit 2))) 
    ) 
    (setq msg (strcat "\n" msg ": ")) 
  );if 
  (initget bit kwd) 
  (setq inp (getreal msg)) 
  (if inp inp def) 
) 
;;; USTR User interface string If BIT=1 no null "" input allowed, 0 for none, BIT 
;;; ignored if DEF present. MSG is the prompt string, to which a default string 
;;; is added as <DEF> (nil or "" for none), and a : is added. If SPFLAG T, spaces 
;;; are allowed in 
;;; string. 
;;; 
;;;>    Author: Henry C. Francis 
;;;>            425 N. Ashe St. 
;;;>            Southern Pines, NC 28387 
;;;>            [url]http://paracadd.com[/url] 
;;;>            All rights reserved. 
;;; 
;;;>            COPYRIGHT: 1-14-98 
;;;>               EDITED: 03-02-2001 
;;; 
(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 
              ) ;_ end of if 
    ) ;_ end of setq 
    (PROGN 
      (SETQ msg (STRCAT "\n" msg ": ")) 
      (IF (= bit 1) 
        (WHILE (= "" (SETQ inp (GETSTRING msg spflag)))) 
        (SETQ inp (GETSTRING msg spflag)) 
      ) ;_ end of if 
    ) ;_ end of progn 
  ) ;_ end of if 
  inp 
)

kkt123 · 发表于 2015-2-15 09:51:05

是挺不错的源码;P

wzjck01 · 发表于 2021-4-1 17:25:26

不错的源码！

[发布] u系列函数

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

本帖被以下淘专辑推荐:

点评

账号		自动登录	找回密码
密码			立即注册