本帖最后由 wowan1314 于 2013-7-27 13:04 编辑
瞎玩! - ;中点函数
- (defun t1 (p1 p2)
- (mapcar '(lambda(a b) (* 0.5 (+ a b))) p1 p2)
- )
- (defun t2 (p1 p2)
- (mapcar '* (mapcar '+ p1 p2)'(0.5 0.5 0.5))
- )
 - ;;消除字符串中的空格
- (defun t11 (str)
- (apply
- 'strcat
- (mapcar
- 'vl-princ-to-string
- (read
- (strcat "(" str ")")
- )
- )
- )
- )
- ;;消除字符串中的空格
- (defun t12 (str)
- (while
- (> (strlen str)
- (strlen
- (setq str (vl-string-subst "" " " str))
- )
- )
- )
- str
- )
 - ;求字符串表 或 数表中 最大的数 或最长的字符串
- (defun t11 (lst)
- (if (= (type (car lst)) 'str)
- (cdr
- (assoc
- (apply
- 'max
- (mapcar
- '(lambda(x)
- (strlen x)
- )
- lst
- )
- )
- (mapcar
- '(lambda(x)
- (list (strlen x) x)
- )
- lst
- )
- )
- )
- (apply 'max lst)
- )
- )
 - ;图元之后所有图元组成的选择集
- (defun t12 (en / ss)
- (setq ss (ssadd))
- (while
- (setq en (entnext en))
- (if (member
- (cdr (assoc 0 (entget en))
- )
- '("attrib" "vertex" "seqend")
- )
- nil
- (setq ss (ssadd en ss))
- )
- )
- ss
- )
- ;;图元之后所有图元的表
- (defun t11 (en / lst)
- (while
- (setq en (entnext en))
- (if (member
- (cdr (assoc 0 (entget en))
- )
- '("attrib" "vertex" "seqend")
- )
- nil
- (setq lst (cons en lst))
- )
- )
- lst
- )
 - ; (t11 '("1" "2" "3" "4" "5" "6") ":")
- ;==> "1:2:3:4:5:6"
- (defun t11 (lst del)
- (vl-string-right-trim
- del
- (apply
- 'strcat
- (mapcar
- '(lambda
- (
- x
- )
- (strcat
- x
- del
- )
- )
- lst
- )
- )
- )
- )
 - ;将字符串表合并为按指定分隔符分隔的字符串
- ; (t11 '("1" "2" "3" "4" "5" "6") ":")
- ;==> "1:2:3:4:5:6"
- (defun t11 (lst del / ss lst p1 p2 p3)
- (vl-string-right-trim
- del
- (eval
- (cons 'strcat
- (mapcar
- '(lambda(x)
- (strcat x del)
- )
- lst
- )
- )
- )
- )
- )
 - ;计算点集中距离原点 (最大 最小)
- (defun t11 (plst)
- (setq lst (vl-sort lst '(lambda(a b) (> (distance a '(0 0 0)) (distance b '(0 0 0)) ))
- )
- )
- (list (car lst)(last lst))
- )
- ;计算点集围成的包围盒的 对角点
- (defun t12 (plst)
- (mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(min max) (list lst lst))
- )
- ;计算实数表中 最大 最小值
- (defun t13 (plst)
- (mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(min max) (list lst lst))
- )
 - ;;等分表,没考虑表的顺序。
- (defun t1 (n lst / a ll zll)
- (setq a 1)
- (mapcar
- '(lambda(x)
- (if (< a n)
- (setq ll (cons x ll) a (1+ a))
- (setq zll (cons (cons x a) zll)
- ll nil
- a 1
- )
- )
- )
- lst
- )
- (if ll (cons ll zll) zll)
- )
 - ;;用新项替换表中的旧项,只替换第一个。
- (defun t2 (new old lst)
- (read(apply 'vl-string-subst (mapcar 'vl-princ-to-string (list new old lst))))
- )
 - ;;点集按pl线的pl起点到点到曲线的最近点的距离排序
- ;;pl为vla实体. 返回排序后的点表
- (defun t11 (pl pts)
- (mapcar
- 'cadr
- (vl-sort
- (mapcar
- '(lambda (x)
- (list (vlax-curve-getdistatpoint
- pl
- (vlax-curve-getclosestpointto pl x)
- )
- x
- )
- )
- pts
- )
- '(lambda (a b)
- (< (car a) (car b))
- )
- )
- )
- )
 - ;;得到表中重复次数 及 删除重复后的表
- ;; (t1 '(1 2 1 2 (1 1) (1 2) (1 2) 1 2))
- (defun t1 (lst / lst1 lst2)
- (mapcar
- '(lambda(x)
- (if (member x lst2)
- (setq lst1 (cons x lst1))
- (setq lst2 (cons x lst2))
- )
- )
- lst
- )
- (list (length lst1) lst2)
- )
 - ;;=============={ 返回表m-n之间的所有元素 }===============
- ;;测试: (T66 3 5 '(2334 556 33 44 66 77 22))==> (33 44 66)
- (DEFUN T66 (n m LST / A)
- (setq A 0)
- (vl-remove-if-not '(lambda(x)(setq A (1+ A)) (<= n A m) ) lst)
- )
 - ;;=============={ 返回表第N个元素之前的所有元素 }===================
- ;;测试: (T2 3 '(2334 556 33 44 66 77 22))==> (2334 556 33)
- (DEFUN T2 (n lst / m NEW)
- (setq m 0)
- (WHILE (< M N)
- (SETQ NEW (CONS (CAR LST) NEW) LST (CDR LST) m (1+ m))
- )
- (REverse NEW)
- )
- ;;=============={ 返回表第N个元素之前的所有元素 }===================
- ;;测试: (T1 3 '(2334 556 33 44 66 77 22))==> (2334 556 33)
- (DEFUN T1 (n lst / m)
- (setq m 0)
- (vl-remove-if '(lambda(x)(setq m (1+ m))(< n m) ) lst)
- )
 - ;;=============={ 用member的话,对于有重复元素的表是不行的 }===================
- ;;测试: (T3 3 '(2334 556 33 44 66 77 22))==> (44 66 77 22)
- (DEFUN T3 (n lst)
- (setq n (nth n lst))
- (member n lst)
- )
- ;;=============={ 返回表第N个元素之后的所有元素 }===================
- ;;测试: (T31 3 '(2334 556 33 44 66 77 22))==> (44 66 77 22)
- (DEFUN T31 (n LST / A)
- (setq A 0)
- (vl-member-if '(lambda(x)(setq A (1+ A)) (< n A) ) lst)
- )
- ;;=============={ 返回表第N个元素之后的所有元素 }===================
- ;;测试: (T32 3 '(2334 556 33 44 66 77 22))==> (44 66 77 22)
- (DEFUN T32 (n LST / A)
- (setq A 0)
- (vl-remove-if '(lambda(x)(setq A (1+ A)) (<= A n) ) lst)
- )
- ;;=============={ 返回表第N个元素之后的所有元素 }===================
- ;;测试: (T33 3 '(2334 556 33 44 66 77 22))==> (44 66 77 22)
- (DEFUN T33 (n LST / A)
- (setq A 0)
- (vl-catch-all-apply
- 'mapcar
- (LIST '(lambda (x)
- (SETQ A (1+ A))
- (if (< N A)
- (EXIT)
- (setq lst (cdr lst))
- )
- )
- lst
- )
- )
- lst
- )
- ;;=============={ 返回表第N个元素之后的所有元素(最优版) }=================
- ;;测试: (T6 3 '(2334 556 33 44 66 77 22))==> (44 66 77 22)
- (DEFUN T6 (n LST / A NLST L)
- (setq A 0 L (LENGTH LST))
- (IF (< N (* L 0.65))
- (SETQ NLST (vl-member-if '(lambda(x)(setq A (1+ A)) (< n A) ) lst))
- (vl-member-if '(lambda(x)(SETQ L (1- L) Nlst (CONS X NLST)) (<= L N) ) (reverse lst))
- )
- NLST
- )
 - ;vl-position返回第一个元素出现的索引位置
- ;这个函数返回元素出现的所有索引位置
- (defun t11 (at lst / a nlst)
- (setq a 0)
- (mapcar '(lambda(x)(and(eq x at)(setq nlst(cons a nlst)))(setq a(1+ a))) lst)
- (reverse nlst)
 - ;TEXT的四个交点坐标
- (defun t11 (ent / p0 p12 ang lst)
- (setq ent (entget ent)
- p0 (cdr (assoc 10 ent))
- ang (cdr (assoc 50 ent))
- p12 (textbox ent)
- lst
- (list
- (car p12)
- (list (caar p12)(cadadr p12))
- (cadr p12)
- (list (caadr p12)(cadar p12))
- )
- )
- (mapcar '(lambda(x)(polar p0 (+ ang (angle '(0 0) x)) (distance '(0 0) x))) lst)
- )
 - ;;给定起点、终点、数量--------定数等分线段,得点表
- ;;调用: (YY-np1p2 P1 P2 N)----- BY wowan1314
- ;;返回值:点表 按据第一个参数P1由近及远的有序点表。
- ;; 如:(P1 P11 P12 P13 . . . P2) 包括起点终点
- (defun YY-np1p2X (p1 p2 n / v m plst)
- (setq v (mapcar '(lambda (x y) (/ (- x y) n)) P2 P1) plst (cons p2 plst) )
- (repeat n
- (setq plst (cons (mapcar '- (car plst) v) plst))
- )
- )
用正则也许更简单! - ;得到文字内容
- (defun gps->txt-getvalue1 (ename)
- (cdr(assoc 1 (entget enmae))
- )
- )
- ;设置文字内容
- (defun gps->txt-setvalue1 (ename val)
- (entmod(subst (cons 1 val)(assoc 1 (entget enmae)) (entget enmae))
- )
- )
- ; 得到带数字后缀的字符串的 (文字前缀、数字后缀、小数点位数)
- (defun t11 (txt1 / nums lop a1 txt len a2)
- (setq nums '(49 50 51 52 53 54 55 56 57 48 43 45 46)
- lop t
- a1 0
- txt (reverse(vl-string->list txt1))
- )
- (while lop
- (if (member (car txt) nums)
- (progn
- (if (= (car txt) 46) (setq a2 a1))
- (setq a1 (1+ a1) txt (cdr txt))
- )
- (setq lop nil)
- )
- )
- (if (/= a1 0)
- (progn
- (setq len (- (strlen txt1) a1))
- (list (substr txt1 1 len) (substr txt1 (1+ len)) a2)
- )
- )
- )
|