[LISP函数]：刚找到的一些实用函数

hqd9639 · 发表于 2003-8-25 17:01:53

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

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

×

[FONT=courier new]
;;; Michels Visual LISP Functions
;;; These functions all work correctly, but containg only minimal error checking
;;;
;;; There are five Trigonometric functions
;;;
;;; (deg->rad angle): input angle in degrees as a real or int, returns angle in radians as real
;;; (rad->deg angle): input angle in radians as a real or int, returns angle in degrees as real
;;; (tan angle): input angle in radians, retuns tangent of angle as real
;;; (asin real): input real, returns arcsine of number in radians
;;; (acos real): input real, returns arcosine of number in radians
;;;
;;; Four general information functions
;;;
;;; (3d->2d 3d point) returns a 2d point
;;; (2d->3d 2d point level) returns a 3d point with z value equal to level or 0.0 if nil
;;; info: select object, retuns a dialog listing entity type and layer, also if in a block and/or XREF
;;; displays names and layers of blocks/XREF's
;;; (stringp atom): returns T if atom is a string
;;; (intp atom): returns T if atom is an integer
;;; (realp atom): returns T if atom is a real number
;;;
;;; Ten list manipulation tools
;;;
;;; (vl-remove-last list): input list, removes last element from list
;;; (strl_sort list): input list of strings, similar to (acad_strlsort) but sorts numbers numerically
;;; (remove atom list): similar to (vl-remove) but only removes first occurance of atom in list
;;; (nth-remove nth list): removes nth element from list
;;; (vl-add atom nth list): adds atom as nth element of list
;;; (sublist start length list): returns a number of elements after start position from a list
;;; (remlist start length list): removes a number of elements after start position from a list
;;; (list->string delim list): input deliminator as string, list, converts elements of list to a deliminated string
;;; (sslist pickset): input selectionsel, returns list of selected entities
;;; (strconv list): converts elements of list into strings
;;;
;;; Ten String functions
;;;
;;; (ltrim string): input string, removes any spaces from the beginning of the string
;;; (rtrim string): input string, removes any spaces from the end of the string
;;; (trim string): input string, removes speces from beginning and end of string
;;; (string->list string): input string, returns the string a list using spaces a delimineater
;;; (mid string string): input two strings, returns first string if it is found within second string else nil
;;; (stringp val): input a value, returns true if value is a string else nil
;;; (strrev string): reverses string
;;; (replace oldstring newstring string): replaces occurances of oldstring in string with newstring
;;; (stringtype string): returns data type of contents of the string
;;; (list->string delim list): converts list into delimted string
;;; (right string int): returns number of charachters from right of string
;;; (left string int): returns number of charachters from left of string
;;; (multiline string int): returns string as a list of strings, each element being no longer than int but finishing with a full word if possible
;;;
;;;(if (null c:fun) checks if lisp routine is loaded
;;; (load fun.lsp) load function
;;; )
(defun c:functions () ;provide to check if routine is loaded
(alert "Functions Routine Loaded")
)
(defun 3d->2d (f_3d) ;converts 3d co-ordinate to 2d
(list (car f_3d) (cadr f_3d))
)
;eg (setq a (3d->2d '(0 0 0))) = (0 0)
(defun 2d->3d (f_d f_3d) ;converts 2d co-ordinate to 3d with given level
(if (not (numberp f_3d))
(setq f_3d 0)
)
(if f_3d
(append f_2d (list f_3d))
(append f_2d '(0.0))
)
)
;eg (setq a (2d->3d '(0 0) 0)) = (0 0 0)
(defun vl-remove-last (f_l) ;removes last element from a list
(setq f_l (reverse (cdr (reverse f_l))))
)
;eg (setq a (vl-remove-last '(1 2 3))) = (1 2)
(defun deg->rad (f_ang) ;converts angles from degrees to radians
(setq f_ang (* pi (/ f_ang 180.0)))
)
;eg (setq a (deg->rad 180)) = 3.14
(defun rad->deg (f_ang) ;converts angles from radians to degrees
(setq f_ang (* 180.0 (/ f_ang pi)))
)
;eg (setq a (rad->deg (/ pi 2.0))) = 90
(defun tan (f_ang / f_tangent) ;tangent funtion usesangles in radians
(setq f_tangent (/ (sin f_ang) (cos f_ang)))
)
;eg (setq a (tan (/ pi 4))) = 1.0
(defun asin (f_ang) ;arcsin function uses angles in radians
(if (= (atof (rtos (abs f_ang))) 1)
0
(atan (/ f_ang (sqrt (+ (* (- f_ang) f_ang) 1))))
)
)
;eg (setq a (asin 0.5)) = 0.523
(defun acos (f_ang) ;arcosine function uses angles in radians
(if (= (atof (rtos (abs f_ang))) 1)
0
(+ (atan (/ (- f_ang) (sqrt (+ (* (- f_ang) f_ang) 1))))
(* 2 (atan 1))
)
)
)
;eg (setq a (acos 0.5)) = 10.0472
(defun strl_sort (f_stringlist / f_numl f_strl f_n f_cur) ; similar to acad_strlsort, but sorts string representing numbers numberically
(setq f_numl nil
f_strl nil
)
(foreach f_n f_stringlist ;loop through each element in list
(progn
(if (numberp (read f_n)) ;test if number
(setq f_numl (append f_numl (list f_n)))
;create list of numbers
(setq f_strl (append f_strl (list f_n)))
;create list of strings
)
)
)
(setq f_stringlist nil)
(repeat (length f_numl) ;loop through list of numbers
(progn
(setq f_cur (car f_numl))
(foreach f_n (cdr f_numl) ;loop through remainder of number list
(if (> (read f_cur) (read f_n)) ;test if current value smaller than elements in list
(setq f_cur f_n) ;if so replace current value with smaller value
)
)
(setq f_numl (remove f_cur f_numl))
;remove current (smallest) value from number list
(setq f_stringlist (append f_stringlist (list f_cur)))
;add current (smallest) value to end of final list
)
)
(repeat (length f_strl) ;loop through list of strings
(progn
(setq f_cur (car f_strl))
(foreach f_n (cdr f_strl) ;loop though remainder of string list
(if (> f_cur f_n) ;test for alphabetical order
(setq f_cur f_n) ;replace current value for precending value
)
)
(setq f_strl (remove f_cur f_strl))
;remove current value from string list
(setq f_stringlist (append f_stringlist (list f_cur)))
;add current value to end of final list
)
)
)
;eg (strl_sort '("b" "a" "10" "1")) = ("1" "10" "a" "b")
(defun remove (f_new f_newlist / f_test) ;removes first occurance of an element from a list
(if (member f_new f_newlist) ;is value present in list
(progn
(setq f_test nil) ;test to see if element removed
(repeat (length f_newlist) ;loop through list
(progn
(if (not (and (= f_test nil) (= (car f_newlist) f_new)))
;test if element removed or element is to be removed
(setq f_newlist
(cdr (append f_newlist (list (car f_newlist))))
) ;swaps moves first element to end of list
(progn
(setq f_test t) ;element has been removed
(setq f_newlist (cdr f_newlist))
;remove first element from list
)
)
)
)
)
)
)
;eg (remove 1 '(1 1 2 1)) = (1 2 1)
(defun nth-remove (f_n f_list / ) ;removes nth element from a list
(if (and (numberp f_n) (listp f_list))
(if (and (>= f_n 0) (< f_n (length f_list)))
(progn
(repeat f_n
(setq f_list (append (cdr f_list) (list (car f_list))))
)
(setq f_list (cdr f_list))
(repeat (- (length f_list) f_n)
(setq f_list (append (cdr f_list) (list (car f_list))))
)
)
)
)
f_list
)
;eg (nth-remove (0 '(1 2 3))) = (2 3)
(defun vl-add (f_new f_n f_newlist) ;add element to nth position in a list
(if (not (listp f_newlist)) ;test if a list
(setq f_newlist (list f_newlist)) ;creates list
)
(cond
((= f_n 0) (setq f_newlist (append (list f_new) f_newlist)))
;if target first element, make into list and add list
((>= f_n (length f_newlist)) ;is target end of list
(setq f_newlist (append f_newlist (list f_new)))
;add element to end of list
)
(t
(progn
(setq f_loop -1) ;initialize counter
(foreach f_x f_newlist ;loop through list
(progn
(setq f_loop (1+ f_loop)) ;increment counter
(if (= f_n f_loop) ;if target element
(setq f_newlist (cdr (append f_newlist (list f_new f_x))))
;add element to end of list, move first element to end of list
(setq f_newlist (cdr (append f_newlist (list f_x))))
;move first element to end of list
)
)
)
)
)
)
)
;eg (vl-add 2 1 '(3 3)) = (3 2 3)
(defun sublist (f_n f_m f_newlist / f_loop f_x) ;returns sublist of a list, similar to substr function
(if (>= (length f_newlist) f_n) ;test range
(progn
(setq f_loop -1) ;initialize counter
(setq f_m (+ f_n (- f_m 1))) ;setq end element
(foreach f_x f_newlist ;loop through list
(progn
(setq f_loop (1+ f_loop)) ;increment counter
(if (and (<= f_n f_loop) (>= f_m f_loop)) ;check within range
(setq f_newlist (cdr (append f_newlist (list f_x))))
;move first element to end of list
(setq f_newlist (cdr f_newlist)) ;remove first element
)
)
)
)
)
)
;eg (sublist 1 2 '(1 2 3 4 5)) = (2 3)
(defun remlist (f_n f_m f_newlist / f_loop f_x) ;removes number of elemts from list
(if (>= (length f_newlist) f_n) ;test range
(progn
(setq f_loop -1) ;initialize counter
(setq f_m (+ f_n (- f_m 1))) ;set end element
(foreach f_x f_newlist ;loop through list
(progn
(setq f_loop (1+ f_loop)) ;increment counter
(if (and (<= f_n f_loop) (>= f_m f_loop)) ;check within range
(setq f_newlist (cdr f_newlist))
;remove first element from list
(setq f_newlist (cdr (append f_newlist (list f_x))))
;move first element to end of list
)
)
)
)
)
)
;eg (remlist 1 2 '(1 2 3 4 5)) = (1 4 5)
(defun string->list (f_string / f_ls f_str f_len f_loop f_cur) ;converts string to a list using spaces as deliminators
(setq f_ls nil
f_str ""
)
(setq f_loop 0)
(repeat (strlen f_string)
(progn
(setq f_loop (1+ f_loop))
(setq f_cur (substr f_string f_loop 1))
(if (= (ascii f_cur) 32)
(if (/= f_str "")
(progn (setq f_ls (append f_ls (list f_str)))
(setq f_str "")
)
)
(setq f_str (strcat f_str f_cur))
)
)
)
(if (/= f_str "")
(setq f_ls (append f_ls (list f_str)))
)
f_ls
)
;eg (string->list "Hello World") = ("Hello" "World")
(defun ltrim (f_string / f_loop) ;removes spaces from left of string
(setq f_loop 1)
(while (= (ascii (substr f_string f_loop 1)) 32)
(setq f_loop (1+ f_loop))
)
(setq f_string (substr f_string f_loop (strlen f_string)))
)
;eg (ltrim " trim ") = "trim "
(defun rtrim (f_string) ;removes spaces from right of string
(setq f_loop 0)
(setq f_len (strlen f_string))
(while (= (ascii (substr f_string (- f_len f_loop) 1)) 32)
(setq f_loop (1+ f_loop))
)
(setq f_string (substr f_string 1 (- f_len f_loop)))
)
;eg (rtrim " trim ") = " trim"
(defun trim (f_string) ;removes spaces from outside of string
(setq f_string (ltrim f_string))
(setq f_string (rtrim f_string))
)
;eg (trim " trim ") = "trim"
(defun mid (f_string1 f_string2 / f_test f_loop) ;tests if string1 is contained in string2
(setq f_test nil)
(cond
((or (= (strlen f_string1) 0) (= (strlen f_string2) 0))
(setq f_test nil)
)
((> (strlen f_string1) (strlen f_string2))
(setq f_test nil)
)
(t
(progn
(setq f_loop 1)
(repeat (- (strlen f_string2) (- (strlen f_string1) 1))
(progn
(if
(= (strcase f_string1)
(strcase (substr f_string2 f_loop (strlen f_string1)))
)
(setq f_test f_string1)
)
(setq f_loop (1+ f_loop))
)
)
)
)
)
f_test
)
;eg (mid "to" "AutoCAD") = "to"
(defun sslist (f_sel) ;converts a selection set to a list of enames
(if f_sel
(progn
(if (/= (type f_sel) 'PICKSET)
(exit)
)
(setq f_ss_list nil
f_loop -1
)
(repeat (sslength f_sel)
(progn
(setq f_loop (1+ f_loop))
(princ (strcat "\rSorting " (itoa f_loop) " of " (itoa (sslength f_sel)) " "))
(setq f_ss_list (append f_ss_list (list (ssname f_sel f_loop))))
)
)
)
nil
)
)
;eg (sslist (ssget)) = (<Entity name: 40061d70> <Entity name: 40061d68>)
(defun strrev (f_string / f_cur) ;reverses a string
(setq f_cur "")
(repeat (strlen f_string)
(progn
(setq f_cur (strcat f_cur (substr f_string (strlen f_string) 1)))
(setq f_string (substr f_string 1 (- (strlen f_string) 1)))
)
)
f_cur
)
;eg (strrev "Hello") = "olleH"
(defun list->string (f_delim f_ls) ;converts a list of strings to a deliminated string
(setq f_string "")
(foreach f_i f_ls
(progn
(setq f_string (strcat f_string f_i f_delim))
)
)
(setq f_string (substr f_string 1 (- (strlen f_string) 1)))
)
;eg (list->string "*" '("1" "2")) = "1*2"
(defun stringp (f_val) ;test if a string
(if (= (type f_val) 'STR)
t
nil
)
)
;eg (stringp "Hello") = true
(defun realp (f_val) ;tests if a real number
(if (= (type f_val) 'REAL)
t
nil
)
)
;eg (realp 1.0) = true
(defun intp (f_val) ;tests if an integer
(if (= (type f_val) 'INT)
t
nil
)
)
;eg (intp 1) = true
(defun strconv (f_ls) ;converts elements of a list to a list of strings
(if (null (listp f_ls))
(exit)
)
(setq f_loop 0)
(while (and (>= f_loop 0) (< f_loop (length f_ls)))
(setq f_cur (car f_ls))
(cond
((stringp f_cur)
(setq f_ls (append (cdr f_ls) (list f_cur)))
)
((realp f_cur)
(setq f_ls (append (cdr f_ls) (list (rtos f_cur))))
)
((intp f_cur)
(setq f_ls (append (cdr f_ls) (list (itoa f_cur))))
)
(t (setq f_loop -2))
)
(setq f_loop (1+ f_loop))
)
(if (>= f_loop 0)
f_ls
nil
)
)
;eg (strconv '(1 2.5 "h")) = ("1" "2.5" "h")
(defun replace (f_oldstr f_newstr f_string / f_cur f_loop) ;like subst but with strings not lists
(if (null (and (stringp f_oldstr)
(stringp f_newstr)
(stringp f_string)
)
)
(exit)
)
(if (> (strlen f_oldstr) (strlen f_string))
(exit)
)
(setq f_loop 1)
(repeat (strlen f_string)
(progn
(setq f_cur (substr f_string f_loop (strlen f_oldstr)))
(if (= f_cur f_oldstr)
(setq f_string (strcat (substr f_string 1 (- f_loop 1))
f_newstr
(substr f_string
(+ f_loop (strlen f_oldstr))
(strlen f_string)
)
)
)
)
(setq f_loop (1+ f_loop))
)
)
f_string
)
;eg (replace "\t" " " "Line one\tLine two") = "Line one Line two"
(defun strtype (f_string) ;returns type of data represented by a string, real int or string
(if (not (stringp f_string))
(exit)
)
(setq f_test nil
f_loop 1
)
(repeat (strlen f_string)
(setq f_cur (substr f_string f_loop 1))
(cond
((= (ascii f_cur) 45)
(if (= f_loop 1)
(setq f_test "REAL")
(setq f_test "STRING")
)
)
((= (ascii f_cur) 46)
(if (/= f_test "STRING")
(setq f_test "REAL")
)
)
((and (>= (ascii f_cur) 48) (<= (ascii f_cur) 57))
(if (and (/= f_test "STRING") (/= f_test "REAL"))
(setq f_test "INT")
)
)
(t (setq f_test "STRING"))
)
(setq f_loop (1+ f_loop))
)
f_test
)
;eg (strtype "1.5") = "REAL"
(defun c:blktxt () ;converts text representing co-ordinates to a block
(setq f_all (ssget "_x" '((0 . "TEXT"))))
(if (null f_all)
(exit)
)
(setq f_all (sslist f_all))
(foreach f_i f_all
(progn
(setq f_tmp (entget i))
(if (/= (strtype (cdr (assoc 1 f_tmp))) "STRING")
(progn
(setq f_x (cadr (assoc 10 f_tmp)))
(setq f_y (caddr (assoc 10 f_tmp)))
(setq f_z (atof (cdr (assoc 1 f_tmp))))
(setq f_ins (list f_x f_y f_z))
(command "-insert"
"pl"
f_ins
""
""
""
(cdr (assoc 1 f_tmp))
""
""
)
)
)
)
)
(princ)
)
(defun c:ca (/ f_sel f_pt1 f_pt2 f_pt3 f_pt4 f_test f_osmode) ;similar to align tool but can copy item
(setq f_osmode -1)
(princ "\nSelect Object(s): ")
(while (null (setq f_sel (ssget))))
(setq f_pt1 (getpoint "\rSelect First Source Point: "))
(setq f_pt2 (getpoint "\rSelect First Destination Point: "))
(setq f_pt3 (getpoint "\rSelect Second Source Point: "))
(setq f_pt4 (getpoint "\rSelect Second Destination Point: "))
(if (not
(or (null f_pt1) (null f_pt2) (null f_pt3) (null f_pt4))
)
(progn
(initget "Yes No")
(setq f_test (getkword "\nScale Objects [Yes/No]<Yes>: "))
(if (null f_test)
(setq f_test "Yes")
)
(if (< (getvar "osmode") 16384)
(progn
(setq f_osmode (getvar "osmode"))
(setvar "osmode" (+ f_osmode 16384))
)
)
(command "copy" f_sel "" f_pt1 f_pt1)
(if (= f_test "Yes")
(command "scale"
f_sel
""
f_pt1
"r"
f_pt1
f_pt3
(distance f_pt2 f_pt4)
)
)
(command "ucs" "z" f_pt2 f_pt4)
(command "rotate"
f_sel
""
(trans f_pt1 0 1)
"r"
(trans f_pt1 0 1)
(trans f_pt3 0 1)
"0"
)
(command "ucs" "p")
(command "move" f_sel "" f_pt1 f_pt2)
(if (/= f_osmode -1)
(setvar "osmode" f_osmode)
)
)
)
(princ)
)
(defun c:lbo (/ f_ent f_col f_layer) ;changes colour of layer to same as selected object
(setq f_ent (entsel "\nselect object: "))
(if (null f_ent)
(exit)
)
(setq f_ent (entget (car f_ent)))
(if (assoc 62 f_ent)
(setq f_col (assoc 62 f_ent))
(exit)
)
(if (or (= (cdr f_col) 0) (= (cdr f_col) 256))
(exit)
)
(setq f_layer (entget (tblobjname "Layer" (cdr (assoc 8 f_ent)))))
(entmod (subst f_col (assoc 62 f_layer) f_layer))
(entmod (subst (cons 62 256) (assoc 62 f_ent) f_ent))
(princ)
)
(defun right (f_string f_len) ;returns x number of characters from right of string
(if (and (stringp f_string) (intp f_len))
(if (and (> f_len 0) (<= f_len (strlen f_string)))
(substr f_string (1+ (- (strlen f_string) f_len)) f_len)
(progn (princ "Out of Range") (princ))
)
(progn (princ "Usage: right <string> <integer>") (princ))
)
)
;eg (right "AutoCAD" 3) = "CAD"
(defun left (f_string f_len) ;returns x number of characters from left of string
(if (and (stringp f_string) (intp f_len))
(if (and (> f_len 0) (<= f_len (strlen f_string)))
(substr f_string 1 f_len)
(progn (princ "Out of Range") (princ))
)
(progn (princ "Usage: right <string> <integer>") (princ))
)
)
;eg (left "Hello" 4) = "Hell"
(defun multiline (f_string f_maxlen) ;converts a string to a list where each element has a length no greater than maxlen
(if (null (stringp f_string))
(exit)
)
(if (null (intp f_maxlen))
(exit)
)
(setq f_strout nil)
(while (< f_maxlen (strlen f_string))
(setq f_newstr (substr f_string 1 f_maxlen))
(setq f_oldstr (substr f_string (+ f_maxlen 1) (strlen f_string)))
(while (and (/= (right f_newstr 1) " ")
(/= (left f_oldstr 1) " ")
(mid " " f_newstr)
)
(setq f_oldstr (strcat (right f_newstr 1) f_oldstr))
(setq f_newstr (substr f_newstr 1 (- (strlen f_newstr) 1)))
)
(setq f_string f_oldstr)
(setq f_strout (append f_strout (list f_newstr)))
)
(setq f_strout (append f_strout (list f_string)))
)
;
(defun stringcase (f_string f_code / f_cur f_i) ;converts case of string, 2 Upper case initial lower case rest, 1 lower case, else uppercase
(if (null c:functions)
(load "functions.vlx")
)
(if (null f_code)
(setq f_code 0)
)
(if (or (null (stringp f_string)) (null (intp f_code)))
(exit)
)
(cond
((= f_code 1) (setq f_string (strcase f_string t)))
((= f_code 2) (progn
(setq f_cur "")
(setq f_string (string->list f_string))
(foreach f_i f_string
(progn
(setq f_i (strcat (strcase (substr f_i 1 1)) (strcase (substr f_i 2 (strlen f_i)) t)))
(setq f_cur (strcat f_cur " " f_i))
)
)
(setq f_string (substr f_cur 2 (strlen f_cur)))
))
(t (setq f_string (strcase f_string)))
)
f_string
)
;eg (stringcase "hello world" 2) = "Hello World"
(defun foreachss (f_var f_ssset f_fun / f_loop)
;function with three parameters variable name,selection set and function
(if (and (eq (type f_var) 'STR) ;check for valid values
(eq (type f_ssset) 'PICKSET)
(eq (type f_fun) 'LIST)
)
(progn
(setq f_loop 0) ;intitialise counter
(while (< f_loop (sslength f_ssset))
;iterate through each item in selection set
(set (read f_var) (ssname f_ssset f_loop))
;populate varible with name provided with ename from selection set
(eval f_fun) ;preform funtion on ename
(setq f_loop (1+ f_loop)) ;next iteration
)
)
)
(princ) ;exit quietly
)
;eg (foreachss "i" (ssget) '(entdel i)) this will delete all of the selected entities [/FONT]

[FONT=courier new] 
;;; Michels Visual LISP Functions 
;;; These functions all work correctly, but containg only minimal error checking 
;;; 
;;; There are five Trigonometric functions 
;;; 
;;; (deg->rad angle): input angle in degrees as a real or int, returns angle in radians as real 
;;; (rad->deg angle): input angle in radians as a real or int, returns angle in degrees as real 
;;; (tan angle): input angle in radians, retuns tangent of angle as real 
;;; (asin real): input real, returns arcsine of number in radians 
;;; (acos real): input real, returns arcosine of number in radians 
;;; 
;;; Four general information functions 
;;; 
;;; (3d->2d 3d point) returns a 2d point 
;;; (2d->3d 2d point level) returns a 3d point with z value equal to level or 0.0 if nil 
;;; info: select object, retuns a dialog listing entity type and layer, also if in a block and/or XREF 
;;;          displays names and layers of blocks/XREF's 
;;; (stringp atom): returns T if atom is a string 
;;; (intp atom): returns T if atom is an integer 
;;; (realp atom): returns T if atom is a real number 
;;; 
;;; Ten list manipulation tools 
;;; 
;;; (vl-remove-last list): input list, removes last element from list 
;;; (strl_sort list): input list of strings, similar to (acad_strlsort) but sorts numbers numerically 
;;; (remove atom list): similar to (vl-remove) but only removes first occurance of atom in list 
;;; (nth-remove nth list): removes nth element from list 
;;; (vl-add atom nth list): adds atom as nth element of list 
;;; (sublist start length list): returns a number of elements after start position from a list 
;;; (remlist start length list): removes a number of elements after start position from a list 
;;; (list->string delim list): input deliminator as string, list, converts elements of list to a deliminated string 
;;; (sslist pickset): input selectionsel, returns list of selected entities 
;;; (strconv list): converts elements of list into strings 
;;; 
;;; Ten String functions 
;;; 
;;; (ltrim string): input string, removes any spaces from the beginning of the string 
;;; (rtrim string): input string, removes any spaces from the end of the string 
;;; (trim string): input string, removes speces from beginning and end of string 
;;; (string->list string): input string, returns the string a list using spaces a delimineater 
;;; (mid string string): input two strings, returns first string if it is found within second string else nil 
;;; (stringp val): input a value, returns true if value is a string else nil 
;;; (strrev string): reverses string 
;;; (replace oldstring newstring string): replaces occurances of oldstring in string with newstring 
;;; (stringtype string): returns data type of contents of the string 
;;; (list->string delim list): converts list into delimted string 
;;; (right string int): returns number of charachters from right of string 
;;; (left string int): returns number of charachters from left of string 
;;; (multiline string int): returns string as a list of strings, each element being no longer than int but finishing with a full word if possible 
;;; 
 
;;;(if (null c:fun)        checks if lisp routine is loaded 
;;;        (load fun.lsp) load function 
;;;        ) 
 
 
(defun c:functions () ;provide to check if routine is loaded 
  (alert "Functions Routine Loaded") 
) 
 
(defun 3d->2d (f_3d)        ;converts 3d co-ordinate to 2d 
  (list (car f_3d) (cadr f_3d)) 
  ) 
;eg (setq a (3d->2d '(0 0 0))) = (0 0) 
 
(defun 2d->3d (f_d f_3d) ;converts 2d co-ordinate to 3d with given level 
  (if (not (numberp f_3d)) 
    (setq f_3d 0) 
    ) 
  (if f_3d 
    (append f_2d (list f_3d)) 
    (append f_2d '(0.0)) 
    ) 
  ) 
;eg (setq a (2d->3d '(0 0) 0)) = (0 0 0) 
 
(defun vl-remove-last (f_l) ;removes last element from a list 
  (setq f_l (reverse (cdr (reverse f_l)))) 
) 
;eg (setq a (vl-remove-last '(1 2 3))) = (1 2) 
 
(defun deg->rad        (f_ang) ;converts angles from degrees to radians 
  (setq f_ang (* pi (/ f_ang 180.0))) 
) 
;eg (setq a (deg->rad 180)) = 3.14 
 
(defun rad->deg        (f_ang) ;converts angles from radians to degrees 
  (setq f_ang (* 180.0 (/ f_ang pi))) 
) 
;eg (setq a (rad->deg (/ pi 2.0))) = 90 
 
(defun tan (f_ang / f_tangent) ;tangent funtion usesangles in radians 
  (setq f_tangent (/ (sin f_ang) (cos f_ang))) 
) 
;eg (setq a (tan (/ pi 4))) = 1.0 
 
(defun asin (f_ang) ;arcsin function uses angles in radians 
  (if (= (atof (rtos (abs f_ang))) 1) 
    0 
    (atan (/ f_ang (sqrt (+ (* (- f_ang) f_ang) 1)))) 
    ) 
) 
;eg (setq a (asin 0.5)) = 0.523 
 
(defun acos (f_ang) ;arcosine function uses angles in radians 
  (if (= (atof (rtos (abs f_ang))) 1) 
    0 
    (+ (atan (/ (- f_ang) (sqrt (+ (* (- f_ang) f_ang) 1)))) 
       (* 2 (atan 1)) 
    ) 
  ) 
) 
;eg (setq a (acos 0.5)) = 10.0472 
 
(defun strl_sort (f_stringlist / f_numl f_strl f_n f_cur) ; similar to acad_strlsort, but sorts string representing numbers numberically 
  (setq        f_numl nil 
        f_strl nil 
  ) 
  (foreach f_n f_stringlist                ;loop through each element in list 
    (progn 
      (if (numberp (read f_n))                ;test if number 
        (setq f_numl (append f_numl (list f_n))) 
                                        ;create list of numbers 
        (setq f_strl (append f_strl (list f_n))) 
                                        ;create list of strings 
      ) 
    ) 
  ) 
  (setq f_stringlist nil) 
  (repeat (length f_numl)                ;loop through list of numbers 
    (progn 
      (setq f_cur (car f_numl)) 
      (foreach f_n (cdr f_numl)                ;loop through remainder of number list 
        (if (> (read f_cur) (read f_n))        ;test if current value smaller than elements in list 
          (setq f_cur f_n)                ;if so replace current value with smaller value 
        ) 
      ) 
      (setq f_numl (remove f_cur f_numl)) 
                                        ;remove current (smallest) value from number list 
      (setq f_stringlist (append f_stringlist (list f_cur))) 
                                        ;add current (smallest) value to end of final list 
    ) 
  ) 
  (repeat (length f_strl)                ;loop through list of strings 
    (progn 
      (setq f_cur (car f_strl)) 
      (foreach f_n (cdr f_strl)                ;loop though remainder of string list 
        (if (> f_cur f_n)                ;test for alphabetical order 
          (setq f_cur f_n)                ;replace current value for precending value 
        ) 
      ) 
      (setq f_strl (remove f_cur f_strl)) 
                                        ;remove current value from string list 
      (setq f_stringlist (append f_stringlist (list f_cur))) 
                                        ;add current value to end of final list 
    ) 
  ) 
) 
;eg (strl_sort '("b" "a" "10" "1")) = ("1" "10" "a" "b") 
 
(defun remove (f_new f_newlist / f_test) ;removes first occurance of an element from a list 
  (if (member f_new f_newlist)                ;is value present in list 
    (progn 
      (setq f_test nil)                        ;test to see if element removed 
      (repeat (length f_newlist)        ;loop through list 
        (progn 
          (if (not (and (= f_test nil) (= (car f_newlist) f_new))) 
                                        ;test if element removed or element is to be removed 
            (setq f_newlist 
                   (cdr (append f_newlist (list (car f_newlist)))) 
            )                                ;swaps moves first element to end of list 
            (progn 
              (setq f_test t)                ;element has been removed 
              (setq f_newlist (cdr f_newlist)) 
                                        ;remove first element from list 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
;eg (remove 1 '(1 1 2 1)) = (1 2 1) 
 
(defun nth-remove (f_n f_list / ) ;removes nth element from a list 
  (if (and (numberp f_n) (listp f_list)) 
    (if (and (>= f_n 0) (< f_n (length f_list))) 
    (progn 
      (repeat f_n 
        (setq f_list (append (cdr f_list) (list (car f_list)))) 
        ) 
      (setq f_list (cdr f_list)) 
      (repeat (- (length f_list) f_n) 
        (setq f_list (append (cdr f_list) (list (car f_list)))) 
        ) 
      ) 
    ) 
    ) 
  f_list 
  ) 
;eg (nth-remove (0 '(1 2 3))) = (2 3) 
 
(defun vl-add (f_new f_n f_newlist)        ;add element to nth position in a list 
  (if (not (listp f_newlist))                ;test if a list 
    (setq f_newlist (list f_newlist))        ;creates list 
  ) 
  (cond 
    ((= f_n 0) (setq f_newlist (append (list f_new) f_newlist))) 
                                        ;if target first element, make into list and add list 
    ((>= f_n (length f_newlist))        ;is target end of list 
     (setq f_newlist (append f_newlist (list f_new))) 
                                        ;add element to end of list 
    ) 
    (t 
     (progn 
       (setq f_loop -1)                        ;initialize counter 
       (foreach        f_x f_newlist                ;loop through list 
         (progn 
           (setq f_loop (1+ f_loop))        ;increment counter 
           (if (= f_n f_loop)                ;if target element 
             (setq f_newlist (cdr (append f_newlist (list f_new f_x)))) 
                                        ;add element to end of list, move first element to end of list 
             (setq f_newlist (cdr (append f_newlist (list f_x)))) 
                                        ;move first element to end of list 
           ) 
         ) 
       ) 
     ) 
    ) 
  ) 
) 
;eg (vl-add 2 1 '(3 3)) = (3 2 3) 
 
(defun sublist (f_n f_m f_newlist / f_loop f_x) ;returns sublist of a list, similar to substr function 
  (if (>= (length f_newlist) f_n)        ;test range 
    (progn 
      (setq f_loop -1)                        ;initialize counter 
      (setq f_m (+ f_n (- f_m 1)))        ;setq end element 
      (foreach f_x f_newlist                ;loop through list 
        (progn 
          (setq f_loop (1+ f_loop))        ;increment counter 
          (if (and (<= f_n f_loop) (>= f_m f_loop)) ;check within range 
            (setq f_newlist (cdr (append f_newlist (list f_x)))) 
                                        ;move first element to end of list 
            (setq f_newlist (cdr f_newlist)) ;remove first element 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
;eg (sublist 1 2 '(1 2 3 4 5)) = (2 3) 
 
(defun remlist (f_n f_m f_newlist / f_loop f_x) ;removes number of elemts from list 
  (if (>= (length f_newlist) f_n)        ;test range 
    (progn 
      (setq f_loop -1)                        ;initialize counter 
      (setq f_m (+ f_n (- f_m 1)))        ;set end element 
      (foreach f_x f_newlist                ;loop through list 
        (progn 
          (setq f_loop (1+ f_loop))        ;increment counter 
          (if (and (<= f_n f_loop) (>= f_m f_loop)) ;check within range 
            (setq f_newlist (cdr f_newlist)) 
                                        ;remove first element from list 
            (setq f_newlist (cdr (append f_newlist (list f_x)))) 
                                        ;move first element to end of list 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
;eg (remlist 1 2 '(1 2 3 4 5)) = (1 4 5) 
 
 
(defun string->list (f_string / f_ls f_str f_len f_loop f_cur) ;converts string to a list using spaces as deliminators 
  (setq        f_ls nil 
        f_str "" 
  ) 
  (setq f_loop 0) 
  (repeat (strlen f_string) 
    (progn 
      (setq f_loop (1+ f_loop)) 
      (setq f_cur (substr f_string f_loop 1)) 
      (if (= (ascii f_cur) 32) 
        (if (/= f_str "") 
          (progn (setq f_ls (append f_ls (list f_str))) 
                 (setq f_str "") 
          ) 
        ) 
        (setq f_str (strcat f_str f_cur)) 
      ) 
    ) 
  ) 
  (if (/= f_str "") 
    (setq f_ls (append f_ls (list f_str))) 
  ) 
  f_ls 
) 
;eg (string->list "Hello World") = ("Hello" "World") 
 
(defun ltrim (f_string / f_loop) ;removes spaces from left of string 
  (setq f_loop 1) 
  (while (= (ascii (substr f_string f_loop 1)) 32) 
    (setq f_loop (1+ f_loop)) 
  ) 
  (setq f_string (substr f_string f_loop (strlen f_string))) 
) 
;eg (ltrim "  trim  ") = "trim  " 
 
(defun rtrim (f_string) ;removes spaces from right of string 
  (setq f_loop 0) 
  (setq f_len (strlen f_string)) 
  (while (= (ascii (substr f_string (- f_len f_loop) 1)) 32) 
    (setq f_loop (1+ f_loop)) 
  ) 
  (setq f_string (substr f_string 1 (- f_len f_loop))) 
) 
;eg (rtrim "  trim  ") = "  trim" 
 
(defun trim (f_string) ;removes spaces from outside of string 
  (setq f_string (ltrim f_string)) 
  (setq f_string (rtrim f_string)) 
) 
;eg (trim "  trim  ") = "trim" 
 
(defun mid (f_string1 f_string2 / f_test f_loop) ;tests if string1 is contained in string2 
  (setq f_test nil) 
  (cond 
    ((or (= (strlen f_string1) 0) (= (strlen f_string2) 0)) 
     (setq f_test nil) 
    ) 
    ((> (strlen f_string1) (strlen f_string2)) 
     (setq f_test nil) 
    ) 
    (t 
     (progn 
       (setq f_loop 1) 
       (repeat (- (strlen f_string2) (- (strlen f_string1) 1)) 
         (progn 
           (if 
             (=        (strcase f_string1) 
                (strcase (substr f_string2 f_loop (strlen f_string1))) 
             ) 
              (setq f_test f_string1) 
           ) 
           (setq f_loop (1+ f_loop)) 
         ) 
       ) 
     ) 
    ) 
  ) 
  f_test 
) 
;eg (mid "to" "AutoCAD") = "to" 
 
(defun sslist (f_sel) ;converts a selection set to a list of enames 
  (if f_sel 
    (progn 
  (if (/= (type f_sel) 'PICKSET) 
    (exit) 
  ) 
  (setq        f_ss_list nil 
        f_loop -1 
  ) 
  (repeat (sslength f_sel) 
    (progn 
      (setq f_loop (1+ f_loop)) 
      (princ (strcat "\rSorting " (itoa f_loop) " of " (itoa (sslength f_sel)) "     ")) 
      (setq f_ss_list (append f_ss_list (list (ssname f_sel f_loop)))) 
    ) 
  ) 
  ) 
    nil 
    ) 
) 
;eg (sslist (ssget)) = (<Entity name: 40061d70> <Entity name: 40061d68>) 
 
(defun strrev (f_string / f_cur) ;reverses a string 
  (setq f_cur "") 
  (repeat (strlen f_string) 
    (progn 
      (setq f_cur (strcat f_cur (substr f_string (strlen f_string) 1))) 
      (setq f_string (substr f_string 1 (- (strlen f_string) 1))) 
    ) 
  ) 
  f_cur 
) 
;eg (strrev "Hello") = "olleH" 
 
(defun list->string (f_delim f_ls) ;converts a list of strings to a deliminated string 
  (setq f_string "") 
  (foreach f_i f_ls 
    (progn 
      (setq f_string (strcat f_string f_i f_delim)) 
    ) 
  ) 
  (setq f_string (substr f_string 1 (- (strlen f_string) 1))) 
) 
;eg (list->string "*" '("1" "2")) = "1*2" 
 
 
(defun stringp (f_val) ;test if a string 
  (if (= (type f_val) 'STR) 
    t 
    nil 
  ) 
) 
;eg (stringp "Hello") = true 
 
(defun realp (f_val) ;tests if a real number 
  (if (= (type f_val) 'REAL) 
    t 
    nil 
  ) 
) 
;eg (realp 1.0) = true 
 
(defun intp (f_val) ;tests if an integer 
  (if (= (type f_val) 'INT) 
    t 
    nil 
  ) 
) 
;eg (intp 1) = true 
 
(defun strconv (f_ls) ;converts elements of a list to a list of strings 
  (if (null (listp f_ls)) 
    (exit) 
  ) 
  (setq f_loop 0) 
  (while (and (>= f_loop 0) (< f_loop (length f_ls))) 
    (setq f_cur (car f_ls)) 
    (cond 
      ((stringp f_cur) 
       (setq f_ls (append (cdr f_ls) (list f_cur))) 
      ) 
      ((realp f_cur) 
       (setq f_ls (append (cdr f_ls) (list (rtos f_cur)))) 
      ) 
      ((intp f_cur) 
       (setq f_ls (append (cdr f_ls) (list (itoa f_cur)))) 
      ) 
      (t (setq f_loop -2)) 
    ) 
    (setq f_loop (1+ f_loop)) 
  ) 
  (if (>= f_loop 0) 
    f_ls 
    nil 
  ) 
) 
;eg (strconv '(1 2.5 "h")) = ("1" "2.5" "h") 
 
(defun replace (f_oldstr f_newstr f_string / f_cur f_loop) ;like subst but with strings not lists 
  (if (null (and (stringp f_oldstr) 
                 (stringp f_newstr) 
                 (stringp f_string) 
            ) 
      ) 
    (exit) 
  ) 
  (if (> (strlen f_oldstr) (strlen f_string)) 
    (exit) 
  ) 
  (setq f_loop 1) 
  (repeat (strlen f_string) 
    (progn 
      (setq f_cur (substr f_string f_loop (strlen f_oldstr))) 
      (if (= f_cur f_oldstr) 
        (setq f_string (strcat (substr f_string 1 (- f_loop 1)) 
                               f_newstr 
                               (substr f_string 
                                       (+ f_loop (strlen f_oldstr)) 
                                       (strlen f_string) 
                               ) 
                       ) 
        ) 
      ) 
      (setq f_loop (1+ f_loop)) 
    ) 
  ) 
  f_string 
) 
;eg (replace "\t" " " "Line one\tLine two") = "Line one Line two" 
 
(defun strtype (f_string) ;returns type of data represented by a string, real int or string 
  (if (not (stringp f_string)) 
    (exit) 
  ) 
  (setq        f_test nil 
        f_loop 1 
  ) 
  (repeat (strlen f_string) 
    (setq f_cur (substr f_string f_loop 1)) 
    (cond 
      ((= (ascii f_cur) 45) 
       (if (= f_loop 1) 
         (setq f_test "REAL") 
         (setq f_test "STRING") 
         ) 
       ) 
      ((= (ascii f_cur) 46) 
       (if (/= f_test "STRING") 
         (setq f_test "REAL") 
       ) 
      ) 
      ((and (>= (ascii f_cur) 48) (<= (ascii f_cur) 57)) 
       (if (and (/= f_test "STRING") (/= f_test "REAL")) 
         (setq f_test "INT") 
       ) 
      ) 
      (t (setq f_test "STRING")) 
    ) 
    (setq f_loop (1+ f_loop)) 
  ) 
  f_test 
) 
;eg (strtype "1.5") = "REAL" 
 
(defun c:blktxt        () ;converts text representing co-ordinates to a block 
  (setq f_all (ssget "_x" '((0 . "TEXT")))) 
  (if (null f_all) 
    (exit) 
  ) 
  (setq f_all (sslist f_all)) 
  (foreach f_i f_all 
    (progn 
      (setq f_tmp (entget i)) 
      (if (/= (strtype (cdr (assoc 1 f_tmp))) "STRING") 
        (progn 
          (setq f_x (cadr (assoc 10 f_tmp))) 
          (setq f_y (caddr (assoc 10 f_tmp))) 
          (setq f_z (atof (cdr (assoc 1 f_tmp)))) 
          (setq f_ins (list f_x f_y f_z)) 
          (command "-insert" 
                   "pl" 
                   f_ins 
                   "" 
                   "" 
                   "" 
                   (cdr (assoc 1 f_tmp)) 
                   "" 
                   "" 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
) 
 
(defun c:ca (/ f_sel f_pt1 f_pt2 f_pt3 f_pt4 f_test f_osmode) ;similar to align tool but can copy item 
  (setq f_osmode -1) 
  (princ "\nSelect Object(s): ") 
  (while (null (setq f_sel (ssget)))) 
  (setq f_pt1 (getpoint "\rSelect First Source Point: ")) 
  (setq f_pt2 (getpoint "\rSelect First Destination Point: ")) 
  (setq f_pt3 (getpoint "\rSelect Second Source Point:     ")) 
  (setq f_pt4 (getpoint "\rSelect Second Destination Point: ")) 
  (if (not 
        (or (null f_pt1) (null f_pt2) (null f_pt3) (null f_pt4)) 
      ) 
    (progn 
      (initget "Yes No") 
      (setq f_test (getkword "\nScale Objects [Yes/No]<Yes>: ")) 
      (if (null f_test) 
        (setq f_test "Yes") 
      ) 
      (if (< (getvar "osmode") 16384) 
        (progn 
          (setq f_osmode (getvar "osmode")) 
          (setvar "osmode" (+ f_osmode 16384)) 
        ) 
      ) 
      (command "copy" f_sel "" f_pt1 f_pt1) 
      (if (= f_test "Yes") 
        (command "scale" 
                 f_sel 
                 "" 
                 f_pt1 
                 "r" 
                 f_pt1 
                 f_pt3 
                 (distance f_pt2 f_pt4) 
        ) 
      ) 
      (command "ucs" "z" f_pt2 f_pt4) 
      (command "rotate" 
               f_sel 
               "" 
               (trans f_pt1 0 1) 
               "r" 
               (trans f_pt1 0 1) 
               (trans f_pt3 0 1) 
               "0" 
      ) 
      (command "ucs" "p") 
      (command "move" f_sel "" f_pt1 f_pt2) 
      (if (/= f_osmode -1) 
        (setvar "osmode" f_osmode) 
      ) 
    ) 
  ) 
  (princ) 
) 
 
(defun c:lbo (/ f_ent f_col f_layer) ;changes colour of layer to same as selected object 
  (setq f_ent (entsel "\nselect object: ")) 
  (if (null f_ent) 
    (exit) 
  ) 
  (setq f_ent (entget (car f_ent))) 
  (if (assoc 62 f_ent) 
    (setq f_col (assoc 62 f_ent)) 
    (exit) 
  ) 
  (if (or (= (cdr f_col) 0) (= (cdr f_col) 256)) 
    (exit) 
    ) 
  (setq f_layer (entget (tblobjname "Layer" (cdr (assoc 8 f_ent))))) 
  (entmod (subst f_col (assoc 62 f_layer) f_layer)) 
  (entmod (subst (cons 62 256) (assoc 62 f_ent) f_ent)) 
  (princ) 
) 
 
(defun right (f_string f_len) ;returns x number of characters from right of string 
  (if (and (stringp f_string) (intp f_len)) 
    (if        (and (> f_len 0) (<= f_len (strlen f_string))) 
      (substr f_string (1+ (- (strlen f_string) f_len)) f_len) 
      (progn (princ "Out of Range") (princ)) 
    ) 
    (progn (princ "Usage: right <string> <integer>") (princ)) 
  ) 
) 
;eg (right "AutoCAD" 3) = "CAD" 
 
(defun left (f_string f_len) ;returns x number of characters from left of string 
  (if (and (stringp f_string) (intp f_len)) 
    (if        (and (> f_len 0) (<= f_len (strlen f_string))) 
      (substr f_string 1 f_len) 
      (progn (princ "Out of Range") (princ)) 
    ) 
    (progn (princ "Usage: right <string> <integer>") (princ)) 
  ) 
) 
;eg (left "Hello" 4) = "Hell" 
 
(defun multiline (f_string f_maxlen) ;converts a string to a list where each element has a length no greater than maxlen 
  (if (null (stringp f_string)) 
    (exit) 
  ) 
  (if (null (intp f_maxlen)) 
    (exit) 
  ) 
  (setq f_strout nil) 
  (while (< f_maxlen (strlen f_string)) 
    (setq f_newstr (substr f_string 1 f_maxlen)) 
    (setq f_oldstr (substr f_string (+ f_maxlen 1) (strlen f_string))) 
    (while (and        (/= (right f_newstr 1) " ") 
                (/= (left f_oldstr 1) " ") 
                (mid " " f_newstr) 
           ) 
      (setq f_oldstr (strcat (right f_newstr 1) f_oldstr)) 
      (setq f_newstr (substr f_newstr 1 (- (strlen f_newstr) 1))) 
    ) 
    (setq f_string f_oldstr) 
    (setq f_strout (append f_strout (list f_newstr))) 
  ) 
  (setq f_strout (append f_strout (list f_string))) 
) 
; 
 
(defun stringcase (f_string f_code / f_cur f_i) ;converts case of string, 2 Upper case initial lower case rest, 1 lower case, else uppercase 
  (if (null c:functions) 
    (load "functions.vlx") 
    ) 
  (if (null f_code) 
    (setq f_code 0) 
    ) 
  (if (or (null (stringp f_string)) (null (intp f_code))) 
    (exit) 
    ) 
  (cond 
    ((= f_code 1) (setq f_string (strcase f_string t))) 
    ((= f_code 2) (progn 
                  (setq f_cur "") 
                  (setq f_string (string->list f_string)) 
                  (foreach f_i f_string 
                    (progn 
                      (setq f_i (strcat (strcase (substr f_i 1 1)) (strcase (substr f_i 2 (strlen f_i)) t))) 
                      (setq f_cur (strcat f_cur " " f_i)) 
                      ) 
                    ) 
                  (setq f_string (substr f_cur 2 (strlen f_cur))) 
                  )) 
    (t (setq f_string (strcase f_string))) 
    ) 
  f_string 
  ) 
;eg (stringcase "hello world" 2) = "Hello World" 
 
(defun foreachss (f_var f_ssset f_fun / f_loop) 
                                        ;function with three parameters variable name,selection set and function 
  (if (and (eq (type f_var) 'STR)        ;check for valid values 
           (eq (type f_ssset) 'PICKSET) 
           (eq (type f_fun) 'LIST) 
      ) 
    (progn 
      (setq f_loop 0)                        ;intitialise counter 
      (while (< f_loop (sslength f_ssset)) 
                                        ;iterate through each item in selection set 
        (set (read f_var) (ssname f_ssset f_loop)) 
                                        ;populate varible with name provided with ename from selection set 
        (eval f_fun)                        ;preform funtion on ename 
        (setq f_loop (1+ f_loop))        ;next iteration 
      ) 
    ) 
  ) 
  (princ)                                ;exit quietly 
) 
;eg (foreachss "i" (ssget) '(entdel i)) this will delete all of the selected entities  [/FONT]

hgqhq · 发表于 2003-8-28 12:56:30

初步看了一下，挺好！我想有哪位再稍加解释，最好不过了，别笑话本人e文水平有限

大土匪 · 发表于 2003-8-31 09:59:43

能否讲解一下如何用

libo2000 · 发表于 2003-8-31 11:45:00

该函数有bug,
(replace "o" "n" "test oooo")
(replace "o" "ne" "test oooo")
(replace "o" "new" "test oooo")
(replace "o" "newo" "test oooo")
(replace "o" "newoo" "test oooo")
有可能得出错误的结果

谁能改改吗？
我实在改不过来----脑袋太小

[FONT=courier new]
(defun replace (f_oldstr f_newstr f_string / f_cur f_loop) ;like subst but with strings not lists
(if (null (and (stringp f_oldstr)
(stringp f_newstr)
(stringp f_string)
)
)
(exit)
)
(if (> (strlen f_oldstr) (strlen f_string))
(exit)
)
(setq f_loop 1)
(repeat (strlen f_string)
(progn
(setq f_cur (substr f_string f_loop (strlen f_oldstr)))
(if (= f_cur f_oldstr)
(setq f_string (strcat (substr f_string 1 (- f_loop 1))
f_newstr
(substr f_string
(+ f_loop (strlen f_oldstr))
(strlen f_string)
)
)
)
)
(setq f_loop (1+ f_loop))
)
)
f_string
)
;eg (replace "\t" " " "Line one\tLine two") = "Line one Line two"
[/FONT]

[FONT=courier new] 
(defun replace (f_oldstr f_newstr f_string / f_cur f_loop) ;like subst but with strings not lists 
  (if (null (and (stringp f_oldstr) 
                 (stringp f_newstr) 
                 (stringp f_string) 
            ) 
      ) 
    (exit) 
  ) 
  (if (> (strlen f_oldstr) (strlen f_string)) 
    (exit) 
  ) 
  (setq f_loop 1) 
  (repeat (strlen f_string) 
    (progn 
      (setq f_cur (substr f_string f_loop (strlen f_oldstr))) 
      (if (= f_cur f_oldstr) 
        (setq f_string (strcat (substr f_string 1 (- f_loop 1)) 
                               f_newstr 
                               (substr f_string 
                                       (+ f_loop (strlen f_oldstr)) 
                                       (strlen f_string) 
                               ) 
                       ) 
        ) 
      ) 
      (setq f_loop (1+ f_loop)) 
    ) 
  ) 
  f_string 
) 
;eg (replace "\t" " " "Line one\tLine two") = "Line one Line two" 
 
  [/FONT]

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

[LISP函数]：刚找到的一些实用函数

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

相关帖子

浏览过的版块