建议大家贴出自己的通用子程序.

雪山飞狐_lzh

这个用递归做的 (defun Str2Chrs(str / pAsc)
(setq pAsc (if (< (ascii str) 128) 1 2))
(cond ((> (strlen str) pAsc)
(cons (substr str 1 pAsc) (str2Chrs (substr str (1+ pAsc)))))
((list (substr str 1 pAsc))))
)

Ea

Lisp不要太过追求通用，根据每个程序的特性写函数才能提高Lisp的运行效率

mccad

spring发表于2004-10-30 14:17:00不错是个好的建议,强烈要求置顶 ;;;功能:取得文件内容;;;By-Spring;;;2004/10/26(defun GET_FILE_GLA (fi / fil pe fel gla_list)   (setq gl...

这是实用函数栏目中的函数：
http://www.mjtd.com/function/list.asp?id=119&ordertype=byletter&orderkey=2

2. (defun mc_getfile(files / tmplst x fn)
3.     (setq files(findfile files))
4.     (if files
5.         (progn
6.             (setq fn (open    files "r"))
7.             (while (setq x (read-line fn))
8.                 (setq tmplst(append tmplst(list x)))
9.             )
10.             (close fn)
11.             tmplst
12.         )
13.          nil
14.     )
15. )

(defun mc_getfile(files / tmplst x fn)     (setq files(findfile files))     (if files         (progn             (setq fn (open    files "r"))             (while (setq x (read-line fn))                 (setq tmplst(append tmplst(list x)))             )             (close fn)             tmplst         )          nil     ) )

mccad

yxp发表于2004-10-30 13:32:00以表的形式返回CAD的搜索路径 (defun ipath(/ ss k kk sstl)(setq ss (getenv \"ACAD\") k 1 kk 1)(while (<= (progn (if (= (substr ss k 1) \";\") ...

这是实用函数中的函数：
http://www.mjtd.com/function/list.asp?id=216&ordertype=byletter&orderkey=7

(defun parse (str delim / lst pos) (setq pos (vl-string-search delim str)) (while pos (setq lst (cons (substr str 1 pos) lst) str (substr str (+ pos 2)) pos (vl-string-search delim str) ) ) (if (> (strlen str) 0) (setq lst (cons str lst)) ) (reverse lst) )

功能

分列，返回一个包含在具有分隔符的字符串所有的标记的列表

语法

(parse str delim)

参数

一个具有分隔符的字符串和分隔符

样例

(ax:Parse (getenv "ACAD") ";")

mccad

大家有好的通用函数，以后会收集在实用函数栏目中供大家使用。

无痕

mccad发表于2004-10-31 8:15:00以下是引用yxp在2004-10-30 13:32:49的发言：以表的形式返回CAD的搜索路径 (defun ipath(/ ss k kk sstl)(setq s...

这个是我的：

2. (defun strsub (rep pat str)
3.    (while (vl-string-search pat str )
4.        (setq str (vl-string-subst rep pat str))
5.    )
6. )
7. (read(strcat "(" (strsub   " " ";" (getenv "ACAD")) ")"))

(defun strsub (rep pat str)    (while (vl-string-search pat str )        (setq str (vl-string-subst rep pat str))    ) ) (read(strcat "(" (strsub   " " ";" (getenv "ACAD")) ")"))

;;->(C:\\PROGRAM FILES\\LIZHENG\\LAR2004\\SYS C:\\DOCUMENTS AND SETTINGS\\LXX1 DATA\\AUTODESK\\AUTOCAD 2004\\R16 C:\\AUTOCAD 2004\\SUPPORT C:\\AUTOCAD 2004\\FONTS C:\\AUTOCAD 2004\\HELP C:\\AUTOCAD 2004\\EXPRESS C:\\AUTOCAD 2004\\SUPPORT\\COLOR D:\\LXX\\-MYLSP D:\\LXX\\-BLK D:\\SHX C:\\WORKTOOLS C:\\XDSOFT0 C:\\XDSOFT0 C:\\XDSOFT0 C:\\XDSOFT0 C:\\XDSOFT0 D:\\LXX C:\\TEMP)

复制代码

yxp

楼上的函数果然简洁了许多,不过我不太会用扩展函数,因为它在R14下好象不太好使.

无痕

不好意思，16楼的程序应用方向有误:P 出个题目给大家研究一下：

1. ;|(x$sub*   新字符 过滤 字符串) ＝> 用"新字符" 替换字符串中符合"过滤"的所有子字符串
2. (x$sub*   " " ";,@,通道" "14;z5我a3;明经通道4b6;;c到12;z8");;-> "14   5我 3 明经 4 6     到12   8"
3. (x$sub*   " " ";,@,明经通道,#" "14;z5我a3;明经通道4b6;;c到12;z8") ;;-> "         我                   到         "
4. (x$sub*   " " ";,@,通道,   " "14;z5我 a3;明经   @通道4b6;;c到   12;z8")  ;;-> "14   5我   3 明经 @ 4 6     到 12   8"   (x$sub*   " "   "明经[a-d;-]通道,;" "14;z明经-通道5我a3;明经a通道4b6;明经;通道;c到明经c通道12;z8") ;;-> "14 z 5我a3   4b6     c到 12 z8"
5. |;

复制代码

wdb

写连续编号的程序，比如：1 2 3 4 5 ....... 或101WORD 102WORD 103WORD....... (defun c:nu (/ wordPt startNumber wordAngle wordHight eng myword)
(setq wdb-os (getvar "OSMODE")) ; Save OSNAP mode
(setvar "OSMODE" 0) ; Turn off OSNAPde
(setq wdb-cm (getvar "CMDECHO")) ; Save OSNAP mode
(setvar "CMDECHO" 0) (setq eng (list
(cons 0 "TEXT")

;(cons 5 173)
;(cons 100 AcDbEntity)
;(cons 67 0)
;(cons 410 Model)
;(cons 8 0)
;(cons 100 AcDbText)
(cons 10 (list 363.89 168.37 0.0))
(cons 40 3.0)
(cons 1 "3")
;(cons 50 0.0)
;(cons 41 0.6)
;(cons 51 0.0)
;(cons 7 ROMANS)
;(cons 71 0)
(cons 72 1)
(cons 11 (list 100 0.0 0.0))
;(cons 210 0.0 0.0 1.0)
;(cons 100 AcDbText)
;(cons 73 0)
)
)
;(setq eng(append '((-1 . <图元名: 1db0b18>))eng))
;(setq eng(entget(ssname (ssget "X" '((0 . "TEXT")))0)))

(setq wordAngle (getreal "\n输入字体的旋转角度<0>:"))
(if (not wordAngle)
(setq wordAngle 0)
)
(setq wordHight(getvar "DIMTXT"))
(setq wordHight (getreal (strcat "\n输入字体的高度<" (rtos wordHight 2 2) ">:")))
(if (or(not wordHight)(= wordHight ""))
(setq wordHight(getvar "DIMTXT"))
)
(if (<= wordAngle -360)
(setq wordAngle 0)
)
(if (>= wordAngle 360)
(setq wordAngle 0)
)
(setq myword (getstring "\n输入起始数<1>:"))
(if(= myword "")(setq myword nil))
(if myword
(progn
(setq startNumber (atoi myword))
(setq myword(substr myword (1+(strlen(itoa startNumber)))))
(if(= myword "")(setq myword nil))
)
)
(if (not startNumber)
(setq startNumber 1)
)
(if myword
(princ (strcat "\n点中数字 "
(strcat (itoa startNumber) myword)
" 的插入点!"
)
)
(princ
(strcat "\n点中数字 " (itoa startNumber) " 的插入点!")
)
)
(setq wordPt (getpoint))
(while wordPt
;(setq eng (subst (cons 0 "TEXT") (assoc 0 eng) eng))
(setq eng (subst (cons 10 wordPt) (assoc 10 eng) eng))
(setq eng (subst (cons 11 wordPt) (assoc 11 eng) eng))
(setq eng (subst (cons 40 wordHight) (assoc 40 eng) eng))
(setq eng (subst (cons 50 (* pi (/ wordAngle 180.0)))
(assoc 50 eng)
eng
)
)
(if myword
(setq eng (subst (cons 1 (strcat (itoa startNumber) myword))
(assoc 1 eng)
eng
)
)
(setq eng (subst (cons 1 (itoa startNumber)) (assoc 1 eng) eng))
)
(entmake eng) (setq startNumber (1+ startNumber))
(if myword
(princ (strcat "\n点中数字 "
(strcat (itoa startNumber) myword)
" 的插入点!"
)
)
(princ
(strcat "\n点中数字 " (itoa startNumber) " 的插入点!")
)
)
(setq wordPt (getpoint))
)
(setvar "OSMODE" wdb-os) ;
(setvar "CMDECHO" wdb-cm) ;恢复原数据
(setq wdb-os nil)
(setq wdb-cm nil)
(print)
)

yxp

楼上的，你那个能作为子程序使用吗？ 下面是关于符号和字符之间互相转换的两个函数。 (defun sytr(abc)
(car (read (strcat "(" abc " 1)" )))
) 示例：(sytr "aaa")返回aaa (defun trsy(abc / axt)
(setq axt(open "rtts" "w")) (princ abc axt)(close axt)
(setq axt(open "rtts" "r") abc (read-line axt))(close axt)
abc) 示例：(setq aa '(aaa 432 11)) (trsy (car aa)) 返回"AAA"