各位大神看下，这个是明经里面的程序，截取文字并改，能不能改成截取文字到粘贴板

664571221 · 发表于 2021-12-3 14:55

各位大神看下，这个是明经里面的程序，截取文字并改，能不能改成截取文字到粘贴板
(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-4 17:14

本帖最后由 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)
)

664571221 · 发表于 2021-12-5 09:49

ssyfeng 发表于 2021-12-4 17:14
(defun explodestr(a / c);;字串拆分by llsheng_73
(setq a(vl-string->list a))
(while( ...

谢谢大神.....

664571221 · 发表于 2021-12-5 09:54

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:11

可能是你捕捉开着吧，我等下修改一下，把拾取点的时候把捕捉关了就好了。你自己可以关了捕捉试试

ssyfeng · 发表于 2021-12-6 09:15

664571221 · 发表于 2021-12-6 11:03

ssyfeng 发表于 2021-12-6 09:15

好了是吗，那我试一下哦

664571221 · 发表于 2021-12-6 11:04

ssyfeng 发表于 2021-12-6 09:15

no function definition: A为啥一直提示的这个

ssyfeng · 发表于 2021-12-6 12:05

没有这个函数，我发文件你直接加载试试：

664571221 · 发表于 2021-12-6 14:38

ssyfeng 发表于 2021-12-6 12:05
没有这个函数，我发文件你直接加载试试：

你好大佬你发的这个就可以运行谢谢了

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

[提问] 各位大神看下，这个是明经里面的程序，截取文字并改，能不能改成截取文字到粘贴板

本帖子中包含更多资源

本帖子中包含更多资源