给定起点、终点、数量--------定数等分线段，得点表

wowan1314 · 发表于 2013-6-18 22:56:10

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

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

×

本帖最后由 wowan1314 于 2013-6-19 13:45 编辑

想到XD发布的“ 给起点和角度、距离和数量，求点表”
所以就做了这个函数“给定起点、终点、数量--------定数等分线段，得点表”

;;给定起点、终点、数量--------定数等分线段，得点表
;;调用: (YY-np1p2 P1 P2 N)----- BY wowan1314
;;返回值:点表按据第一个参数P1由近及远的有序点表。
;; 如：(P11 P12 P13 . . .) 不包括起点终点
(defun YY-np1p2 (p1 p2 n / v m plst)
(setq m 0 v (mapcar '(lambda (x y) (/ (- x y) n)) P2 P1) n (1- n))
(while (< m n)
(setq m (1+ m)
plst (cons (mapcar '(lambda(x y)(- x (* m y))) p2 v) plst)
)
)
)

kwok · 发表于 2013-6-18 22:59:19

谢谢分享，
好象看过论坛里也有这个功能的lsp, 看看这个有什么不同.

wowan1314 · 发表于 2013-6-18 23:18:42

本帖最后由 wowan1314 于 2013-6-19 13:46 编辑

点为2D/3D点，也勉强算是向量的一点运用。
代码还可以再精简一下，明天来改吧

Free-Lancer · 发表于 2013-6-19 19:07:51

(defun XD::PTS:DivN (p1 p2 n / v ptl)
(setq v (mapcar '(lambda (x) (/ x n)) (mapcar '- p2 p1))
ptl (list p1)
)
(repeat n
(setq ptl (cons (mapcar '+ (car ptl) v) ptl))
)
(reverse ptl)
)

wowan1314 · 发表于 2013-6-20 14:01:46

根据“Free-Lancer”的指导。。
调整下代码如下：此版是包括P1 P2点的版本

;;给定起点、终点、数量--------定数等分线段，得点表
;;调用: (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))
)
)

taner · 发表于 2013-6-20 14:46:10

(defun 2pts-npts (p1 p2 intval / dis an intv pts)
(setq dis (distance p1 p2)
an (angle p1 p2)
intv (/ dis (* 1.0 intval))
)
(setq pts (list p1))
(repeat (- intval 1)
(setq p1 (polar p1 an intv)
pts (cons p1 pts)
)
)
(setq pts (cons p2 pts))
(reverse pts)
)

st788796 · 发表于 2013-6-20 16:00:11

taner 发表于 2013-6-20 14:46

既然Polar，倒过来算省一次 Reverse

wowan1314 · 发表于 2013-7-16 18:32:59

本帖最后由 wowan1314 于 2013-7-27 13:03 编辑

复制代码

;============{ 在指定位置删除或插入元素 }===============
;nil表示要删除。如果有值为要插入的元素---by wowan1314
;(t11 '(1 2 3 4 5 6) 2 0);;->(1 2 0 3 4 5 6)
;(t11 '(1 2 3 4 5 6) 2 nil);;->(1 2 4 5 6)
;2013年7月20日星期六
(defun t11 (lst pos mod / qlst a hlst)
(setq a -1)
(setq hlst (vl-member-if-not
'(lambda(x)
(setq a (1+ a))
(if (= a pos) nil
(setq qlst (cons x qlst))
)
)
lst
)
)
(if mod
(apply 'append (list (reverse(cons mod qlst)) hlst))
(apply 'append (list (reverse qlst) (cdr hlst)))
)
)

练习着玩

;中点函数
(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 t1 (en xin / enb)
(setq enb (entget en))
(mapcar '(lambda(x)
(entmod(subst x (assoc (car x) enb)enb))
)
xin
)
)
;表中两个两个配对后的表
(defun t3 (lst / a)
(setq a 0)
(vl-remove-if '(lambda(x)(= (rem (setq a (1+ a))2)0))
(mapcar 'cons lst (cdr lst))
)
)
;得到表的奇偶项
;(T2 LST T)奇数项。(T2 LST NIL)为偶数
(defun t2 (lst b / a)
(setq a 0
c '(lambda(x)(= (rem (setq a (1+ a))2)0))
)
(if b
(vl-remove-if c lst)
(vl-remove-if-not c lst)
)
)

;选择集变图元名表
(defun t1 (ss)
(cdr(reverse(mapcar 'cadr (ssnamex (ssget))
)
)
)
)
;选择集变图元名表
(defun t2 (ss / a en lst)
(setq a -1)
(while (setq en (ssname ss (setq a (1+ a))
)
)
(setq lst (cons en lst))
)
lst
)
;图元名表变选择集
(defun t3 (lst / ss)
(setq ss (ssadd))
(mapcar '(lambda(x)(setq ss (cons x ss)))lst)
ss
)
;dxf_read 按值或值表读取组码表
(defun dxf_read (a en / enb)
(setq enb (entget en))
(if (= 'list (type a))
(mapcar '(lambda(x)(cdr(assoc x enb))) a)
(cdr(assoc a enb))
)
)

;单个图元包围盒
(defun enbox (ename / ll ur)
(vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;选择集包围盒1
(defun t12 (ss / enma enmi a en ll ur)
(setq a -1)
(while
(setq en (ssname ss (setq a (1+ a))
)
)
(setq entb (enbox en)
enma (cons (car entb) enma)
enmi (cons (cadr entb) enmi)
)
)
(mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(max min) (list enma enmi))
)
;选择集包围盒2
(defun t11 (ss / a en enma enmi ll ur)
(setq a -1)
(while
(setq en (ssname ss (setq a (1+ a))
)
)
(vla-getboundingbox (vlax-ename->vla-object en) 'll 'ur)
(setq enma (cons (vlax-safearray->list ll) enma)
enmi (cons (vlax-safearray->list ur) enmi)
)
)
(mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(max min) (list enma enmi))
)
;图元名表包围盒
(defun t13 (sslst / enma enmi ll ur)
(mapcar
'(lambda(x)
(vla-getboundingbox (vlax-ename->vla-object x) 'll 'ur)
(setq enma (cons (vlax-safearray->list ll) enma)
enmi (cons (vlax-safearray->list ur) enmi)
)
)
sslst
)
(mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(max min) (list enma enmi))
)

;单个图元包围盒 
(defun enbox (ename / ll ur) 
    (vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur) 
    (mapcar 'vlax-safearray->list (list ll ur)) 
) 
;选择集包围盒1 
(defun t12 (ss / enma enmi a en ll ur) 
    (setq a -1) 
    (while 
        (setq en (ssname ss (setq a (1+ a)) 
            ) 
        ) 
        (setq entb (enbox en) 
            enma (cons (car entb) enma) 
            enmi (cons (cadr entb) enmi) 
        ) 
    ) 
    (mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(max min) (list enma enmi)) 
) 
;选择集包围盒2 
(defun t11 (ss / a en enma enmi ll ur) 
    (setq a -1) 
    (while 
        (setq en (ssname ss (setq a (1+ a)) 
            ) 
        ) 
        (vla-getboundingbox (vlax-ename->vla-object en) 'll 'ur) 
        (setq enma (cons (vlax-safearray->list ll) enma) 
            enmi (cons (vlax-safearray->list ur) enmi) 
        ) 
    ) 
    (mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(max min) (list enma enmi)) 
) 
;图元名表包围盒 
(defun t13 (sslst / enma enmi ll ur) 
    (mapcar 
        '(lambda(x) 
            (vla-getboundingbox (vlax-ename->vla-object x) 'll 'ur) 
            (setq enma (cons (vlax-safearray->list ll) enma) 
                enmi (cons (vlax-safearray->list ur) enmi) 
            ) 
        ) 
        sslst 
    ) 
    (mapcar '(lambda(a b)(apply 'mapcar (cons a b))) '(max min) (list enma enmi)) 
)

3/分割字符串--高飞鸟的该代码不能处理字符串中带空格的字符

(defun split (string del / str)
(setq str (vl-string-translate del " " string))
(mapcar 'vl-princ-to-string (read (strcat "(" str ")")))
)

1/分隔字符串

按分隔符分解字符串成表.
(defun t11 (str del / pos lst)
(while
(setq pos (vl-string-search del str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ 1 pos (strlen del))
)
)
)
(reverse(cons str lst))
)

2/圆弧三点求其圆心半径

;|
=============={ 三点求ARC:圆心+半径 }============
三点求ARC的圆心、半径。返回值:(圆心坐标半径) 、nil表示三点共线
(YY-3arc P1 P2 P3) BY wowan1314
2013年7月16日星期二
============================================
|;
(defun YY-3arc (p1 p2 p3 / z1 z2 yxin)
(setq z1 (car (YY-np1p2 p1 p2 2))
z2 (car (YY-np1p2 p1 p3 2))
)
(if
(setq yxin (inters
z1 (polar z1 (+ (angle p1 p2)(* pi 0.5)) 0.1)
z2 (polar z2 (+ (angle p1 p3)(* pi 0.5)) 0.1)
nil
)
)
(list yxin (distance yxin p1))
)
)

st788796 · 发表于 2013-7-16 19:34:35

本帖最后由 st788796 于 2013-7-16 19:35 编辑

wowan1314 发表于 2013-7-16 18:32
圆弧三点求其圆心半径

这就有点浪费了，Lisp 尽量减少互相调用以提高效率

(defun 3parc (p1 p2 p3 / midp _pi2 an1 an2 p10 p20 p)
(defun midp (p1 p2)
(mapcar '* '(0.5 0.5 0.5) (mapcar '+ p1 p2))
)
(setq _pi2 (/ pi 2)
an1 (+ (angle p1 p2) _pi2)
an2 (+ (angle p2 p3) _pi2)
p10 (midp p1 p2)
p20 (midp p2 p3)
)
(if (setq p (inters p10
(polar p10 an1 10.)
p20
(polar p20 an2 10.)
nil
)
)
(list p (distance p p1))
)
p
)

wowan1314 · 发表于 2013-7-16 19:48:22

本帖最后由 wowan1314 于 2013-7-25 13:12 编辑

st788796 发表于 2013-7-16 19:34
这就有点浪费了，Lisp 尽量减少互相调用以提高效率

呵呵。函数都做出来，能用就用撒！我这个函数还省了再做个中点函数了。

;删除相应组码
(defun t1 (lst1 lst)
(vl-remove-if '(lambda(x)(member x lst1)) lst)
)
;删除相应组码只删第一个
(defun t2 (lst1 lst / lst2)
(vl-remove-if '(lambda(x)
(if
(and(member x lst1)(not(member x lst2))
)
(setq lst2 (cons x lst2))
)
)
lst
)
)
;替换组码表，如果没有就加到最后
(defun t3 (lst1 lst / old)
(mapcar
'(lambda(x)
(if (setq old (assoc (car x) lst))
(setq lst (subst x old lst))
(setq lst (cons x (reverse lst))
)
)
)
lst1
)
lst
)
;从指定位置a截取指定长度b的表
(defun t4 (lst a b / i c xlst)
(setq i -1 c (1-(+ a b)))
(vl-member-if
'(lambda(x)
(setq i (1+ i))
(if (<= a i c)
(setq xlst (cons x xlst))
)
(if (> i c)
t
)
)
lst
)
xlst
)
;分解表内套的表
(defun t5 (lst )
(mapcar '(lambda(x)(if (listp x)(setq lst2 (t5 x))(setq lst2 (cons x lst2))))lst)
lst2
)

;删除相应组码 
(defun t1 (lst1 lst) 
    (vl-remove-if '(lambda(x)(member x lst1)) lst) 
) 
;删除相应组码只删第一个 
(defun t2 (lst1 lst / lst2) 
    (vl-remove-if '(lambda(x) 
            (if 
                (and(member x lst1)(not(member x lst2)) 
                ) 
                (setq lst2 (cons x lst2)) 
            ) 
        ) 
        lst 
    ) 
) 
;替换组码表，如果没有就加到最后 
(defun t3 (lst1 lst / old) 
    (mapcar 
        '(lambda(x) 
            (if (setq old (assoc (car x) lst)) 
                (setq lst (subst x old lst)) 
                (setq lst (cons x (reverse lst)) 
                ) 
            ) 
        ) 
        lst1 
    ) 
    lst 
) 
;从指定位置a截取指定长度b的表 
(defun t4 (lst a b / i c xlst) 
    (setq i -1 c (1-(+ a b))) 
    (vl-member-if 
        '(lambda(x) 
            (setq i (1+ i)) 
            (if (<= a i c) 
                (setq xlst (cons x xlst)) 
            ) 
            (if (> i c) 
                t 
            ) 
        ) 
        lst 
    ) 
    xlst 
) 
;分解表内套的表 
(defun t5 (lst ) 
    (mapcar '(lambda(x)(if (listp x)(setq lst2 (t5 x))(setq lst2 (cons x lst2))))lst) 
    lst2 
)

wowan1314 · 发表于 2013-7-20 16:49:57

本帖最后由 wowan1314 于 2013-7-22 17:18 编辑

瞎玩！

;;消除字符串中的空格
(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
)

;;=============={ 用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)
)

用正则也许更简单！

;得到文字内容
(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)
)
)
)

;得到文字内容 
(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) 
        ) 
    ) 
)

GTJ116600 · 发表于 2013-7-20 18:42:04

呵呵，葛老这功力，真是不简单呀！！！我啥时候也能这样呀:lol

金鹅起飞 · 发表于 2013-8-28 16:54:56

厉害哦，这些东西对我来说，是本天书呀！向大师们致敬！

金鹅起飞 · 发表于 2013-9-2 13:30:47

wowan1314：老师！您真厉害！向您学习！

拉契 · 发表于 2014-3-17 10:30:38

{:soso_e179:} 支持、学习 {:soso_e179:}

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

[点表] 给定起点、终点、数量--------定数等分线段，得点表

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

评分

相关帖子

评分

点评

点评

点评