看了老师写的代码,对autolisp很擅长,想问老师,这样的功能能实现不?网上怎么找都找不了
答案:1 悬赏:0 手机版
解决时间 2021-11-28 19:07
- 提问者网友:抽煙菂渘情少年
- 2021-11-28 05:43
看了老师写的代码,对autolisp很擅长,想问老师,这样的功能能实现不?网上怎么找都找不了
最佳答案
- 五星知识达人网友:举杯邀酒敬孤独
- 2021-11-28 06:46
- 在cad里面,文字及文字内容是两个概念。
提取文字内容到记事本,这个是可以做到的。
(defun c:tes ( / #g1 &h1 &h2 &k1 &kw1 &p1 &ss1 &ss2 &ss5 &tr1 ff x y);框选文字内容到记事本
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(if (null vlax-dump-object) (vl-load-com) )
(princ "
请选择文字")
(if (setq &kw1 (ssget '((0 . "TEXT"))))
(progn
(setq &ss1 '() &h2 nil)
(while (setq &k1 (ssname &kw1 0))
(setq &kw1 (ssdel &k1 &kw1))
(setq #g1 (entget &k1))
(setq &p1 (cdr (assoc 10 #g1)) &tr1 (cdr (assoc 1 #g1)) &h1 (cdr (assoc 40 #g1)))
(if &h2
(if (< &h1 &h2) (setq &h2 &h1))
(setq &h2 &h1)
)
(setq &ss1 (cons (list &p1 &tr1) &ss1))
);while
(setq &h2 (* &h2 0.4) &ss5 '())
(while (car &ss1)
(setq &h1 (- (cadaar (vl-sort &ss1 '(lambda (x y) (> (cadar x) (cadar y))))) &h2))
(setq &ss2 (vl-remove-if-not '(lambda (X) (>= (cadar x) &h1)) &ss1))
(setq &ss2 (apply 'strcat (mapcar 'cadr (vl-sort &ss2 '(lambda (x y) (< (caar x) (caar y)))))))
(setq &ss5 (append &ss5 (list &ss2)))
(setq &ss1 (vl-remove-if '(lambda (X) (> (cadar x) &h1)) &ss1))
);while
(setq ff (open "d://文字到TXT.txt" "w"));D盘建立文本
(while (setq &tr1 (car &ss5));文字内容每行从左到右,
(setq &ss5 (cdr &ss5));然后从上到下排列
(write-line &tr1 ff)
);while
(close ff)
)
)
(princ)
);cad命令【appload】加载autolisp程序,命令【TES】。提取的cad文字内容在D盘【文字到TXT】记事本里面。
我要举报
如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
推荐资讯