各位大神看下，这个是明经里面的程序，截取文字并改，能不能改成截取文字到粘贴板
各位大神看下，这个是明经里面的程序，截取文字并改，能不能改成截取文字到粘贴板(defun explodestr(a / c);;字串拆分by llsheng_73
(setq a(vl-string->list a))
(while(if(<(car a)129)
(setq c(cons(chr(car a))c)a(cdr a))
(setq c(cons(strcat(chr(car a))(chr(cadr a)))c)a(cddr a))))
(reverse c))
(defun Rot2D(v a / c s x y)
(setq c(cos a)s(sin a))
(setq x(car v)y(cadr v))
(list(-(* x c)(* y s))(+(* x s)(* y c))))
(defun ponline(p p1 p2)
(setq p(trans(mapcar'- P P1)0(mapcar'- P2 P1)))
(list(last p)(car p)))
(defun TextUnder(e / a p);;by llsheng_73
(setq p(cdr(assoc 10 e))
a(cdr(assoc 50 e))
e(textbox e))
(mapcar'(lambda(x)(mapcar'+(Rot2D x a)p))(list(car e)(list(caadr e)(cadar e)))))
(defun positionoftxt(e p1 / p d strs i j str a)
(setq e(entget e)i 1
a(assoc 1 e)
p(TextUnder e)str'nil
d(car(apply'ponline(cons p1 p)))
d(if(> d(apply'distance p))(apply'distance p)d)
strs(explodestr(cdr(assoc 1 e)))
str(mapcar'(lambda(x)(vl-string-translate" ""-"x))
(reverse(repeat(length strs)(setq j 0 i(1+ i)str(cons(apply'strcat(vl-remove-if'(lambda(x)(>=(setq j(1+ j))i))strs))str))))))
(cond((<= d(apply'distance(TextUnder(subst(cons 1(car str))a e))))0)
((<=(apply'distance(TextUnder(subst(cons 1(nth(1-(length str))str))(assoc 1 e)e)))d)(length str))
(t(setq j 0)
(while(not(<(apply'distance(TextUnder(subst(cons 1(nth j str))a e)))d
(apply'distance(TextUnder(subst(cons 1(nth(setq j(1+ j))str))a e))))))j)
))
(defun c:tt(/ a b p1 p2 i s c1 c2 c3 p str strs);;屏幕改字
(while(and(setq b(*(getvar'viewsize)0.01(getvar'cursorsize))
i 0 p1(getpoint"\n截取文字第一点"))
(setq p2(getpoint"第二点"p1))
(setq a(angle p1 p2))
(progn
(while(and(< i 4)(null(setq i(1+ i)s(ssget"F"(list(polar p1(+ a pi)(* b i))(polar p2 a(* b i)))'((0 . "TEXT")))))))
(setq s(if s(ssname s 0)))))
(setq p(vl-sort(mapcar'(lambda(x)(positionoftxt s(trans x 1 0)))(list p1 p2))'<)
s(entget s)
a(assoc 1 s)
strs(explodestr(cdr a))
i -1 c1'nil c2'nil c3 nil
c1(apply'strcat(reverse(repeat(car p)(setq i(1+ i)c1(cons(nth i strs)c1)))))
i(1-(car p))
c2(if(apply'= p)(nth(car p)strs)(apply'strcat(reverse(repeat(-(last p)(car p))(setq i(1+ i)c2(cons(nth i strs)c2))))))
i(1-(last p))
c3(apply'strcat(reverse(repeat(-(length strs)(last p))(setq i(1+ i)c3(cons(nth i strs)c3))))))
(if(setq str(getstring(strcat" \""c2"\"替换为:")t))
(entmod(subst(cons 1(strcat c1 str c3))(assoc 1 s)s))))
(princ))
本帖最后由 ssyfeng 于 2021-12-6 09:24 编辑
[*](defun explodestr(a / c);;字串拆分by llsheng_73
[*](setq a(vl-string->list a))
[*](while(if(<(car a)129)
[*] (setq c(cons(chr(car a))c)a(cdr a))
[*] (setq c(cons(strcat(chr(car a))(chr(cadr a)))c)a(cddr a))))
[*](reverse c))
[*](defun Rot2D(v a / c s x y)
[*](setq c(cos a)s(sin a))
[*](setq x(car v)y(cadr v))
[*](list(-(* x c)(* y s))(+(* x s)(* y c))))
[*](defun ponline(p p1 p2)
[*](setq p(trans(mapcar'- P P1)0(mapcar'- P2 P1)))
[*](list(last p)(car p)))
[*](defun TextUnder(e / a p);;by llsheng_73
[*](setq p(cdr(assoc 10 e))
[*] a(cdr(assoc 50 e))
[*] e(textbox e))
[*](mapcar'(lambda(x)(mapcar'+(Rot2D x a)p))(list(car e)(list(caadr e)(cadar e)))))
[*](defun positionoftxt(e p1 / p d strs i j str a)
[*](setq e(entget e)i 1
[*] a(assoc 1 e)
[*] p(TextUnder e)str'nil
[*] d(car(apply'ponline(cons p1 p)))
[*] d(if(> d(apply'distance p))(apply'distance p)d)
[*] strs(explodestr(cdr(assoc 1 e)))
[*] str(mapcar'(lambda(x)(vl-string-translate" ""-"x))
[*] (reverse(repeat(length strs)(setq j 0 i(1+ i)str(cons(apply'strcat(vl-remove-if'(lambda(x)(>=(setq j(1+ j))i))strs))str))))))
[*](cond((<= d(apply'distance(TextUnder(subst(cons 1(car str))a e))))0)
[*] ((<=(apply'distance(TextUnder(subst(cons 1(nth(1-(length str))str))(assoc 1 e)e)))d)(length str))
[*] (t(setq j 0)
[*] (while(not(<(apply'distance(TextUnder(subst(cons 1(nth j str))a e)))d
[*] (apply'distance(TextUnder(subst(cons 1(nth(setq j(1+ j))str))a e))))))j)
[*] )
[*])
[*](defun ZML-CLIP-SETSTRING (STR / HTML RESULT)
[*](and (= (type STR) 'STR)
[*] (setq HTML (vlax-create-object "htmlfile"))
[*] (setq RESULT (vlax-invoke
[*] (vlax-get (vlax-get HTML 'PARENTWINDOW)
[*] 'CLIPBOARDDATA
[*] )
[*] 'SETDATA
[*] "Text"
[*] STR
[*] )
[*] )
[*] (vlax-release-object HTML)
[*])
[*])
[*](defun c:tt (/ a b p1 p2 i s c1 c2 c3 p str strs esc os);;屏幕改字
[*](setq os (getvar "OSMODE"))
[*](setvar "OSMODE" 16384)
[*](while (and (null esc)
[*] (setq b (* (getvar'viewsize) 0.01 (getvar'cursorsize))
[*] i 0
[*] p1 (getpoint"\n截取文字第一点")
[*] )
[*] (setq p2 (getpoint "第二点" p1))
[*] (setq a (angle p1 p2))
[*] (progn
[*] (while (and (< i 4)
[*] (null (setq i (1+ i)
[*] s (ssget "F" (list (polar p1 (+ a pi) (* b i)) (polar p2 a (* b i))) '((0 . "TEXT")))
[*] )
[*] )
[*] )
[*] )
[*] (setq s (if s (ssname s 0)))
[*] )
[*] )
[*] (setq p (vl-sort (mapcar '(lambda (x)
[*] (positionoftxt s(trans x 1 0)))
[*] (list p1 p2)
[*] )
[*] '<
[*] )
[*] s (entget s)
[*] a (assoc 1 s)
[*] strs (explodestr(cdr a))
[*] i -1
[*] c1 'nil
[*] c2 'nil
[*] c3 nil
[*] c1 (apply 'strcat (reverse (repeat (car p)
[*] (setq i (1+ i)
[*] c1 (cons (nth i strs) c1)
[*] )
[*] )
[*] )
[*] )
[*] i (1- (car p))
[*] c2 (if (apply '= p)
[*] (nth (car p) strs)
[*] (apply 'strcat
[*] (reverse (repeat (- (last p) (car p))
[*] (setq i (1+ i)
[*] c2 (cons (nth i strs) c2)
[*] )
[*] )
[*] )
[*] )
[*] )
[*] i (1- (last p))
[*] c3 (apply 'strcat
[*] (reverse (repeat (- (length strs) (last p))
[*] (setq i (1+ i)
[*] c3 (cons (nth i strs) c3)
[*] )
[*] )
[*] )
[*] )
[*] )
[*] (if c2
[*] (progn
[*] (ZML-CLIP-SETSTRING c2)
[*] (setq esc T)
[*] (princ (strcat "\n>>>>>>成功复制：" c2))
[*] )
[*] (princ "\n>>>>>>未选中文字对象！")
[*] )
[*])
[*](setvar "OSMODE" os)
[*](princ)
[*])
ssyfeng 发表于 2021-12-6 12:05
没有这个函数，我发文件你直接加载试试：
大哥你好，这个能不能能改一下，改成截取文字后，直接提示点击屏幕上的一点 ，然后把截取的部分插入到cad里面，文字的属性和原来的都一样 ssyfeng 发表于 2021-12-4 17:14
[*](defun explodestr(a / c);;字串拆分by llsheng_73
[*](setq a(vl-string->list a))
[*](while( ...
你好大神怎么运行不起来 ssyfeng 发表于 2021-12-4 17:14
[*](defun explodestr(a / c);;字串拆分by llsheng_73
[*](setq a(vl-string->list a))
[*](while( ...
谢谢大神..... 可能是你捕捉开着吧，我等下修改一下，把拾取点的时候把捕捉关了就好了。你自己可以关了捕捉试试
ssyfeng 发表于 2021-12-6 09:15
好了是吗 ，那我试一下 哦 ssyfeng 发表于 2021-12-6 09:15
no function definition: A为啥一直提示的这个 没有这个函数，我发文件你直接加载试试：
ssyfeng 发表于 2021-12-6 12:05
没有这个函数，我发文件你直接加载试试：
你好大佬你发的这个就可以运行谢谢了
页:
[1]
2