点线输出坐标值到TXT，同时复制到系统剪切版

ht1480

自己也是抄抄改改的小白，其中的函数出处不记得来自哪了，总之感谢乐于分享的前辈们

有需求的自取之
如果出错的话请先看看自己有没有E盘

1. (DEFUN C:44 (/ aa)
   
2.   (setq aa (car(entsel "\n选择多段线: ")))
   
3.   (getpt aa)
   
4.   (dcfc ptlst)
   
5.   (SET-CLIP-STRING wjyh1)
   
6. (princ)
   
7. )
   
8. 
   
9. ;;获取坐标函数
   
10. (defun getpt(ss)
    
11. (setq ptlst (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) (entget ss))))
    
12. )
    
13. 
    
14. ;;把坐标值写入E盘的“坐标表值.txt”里
    
15. (defun dcfc (ptlst / wjmdz file1 n JXY1 xy X1 y1 TX1 Ty1 TXY J1 JXY JXY1)
    
16.   (setq wjmdz (strcat "e:/坐标表值.txt"))
    
17.   (setq file1 (open wjmdz "w"))
    
18.   (setq n 0)
    
19.   (setq JXY1 (strcat ""))
    
20.   (repeat (length ptlst)
    
21.     (setq xy (nth n ptlst))
    
22.     (setq X1 (RTOS (cadr xy) 2 2))  ;每一组坐标依次求出X的字符
    
23.     (setq y1 (RTOS (car xy) 2 2))  ;每一组坐标依次求出Y的字符
    
24.     (setq TX1 (strcat X1 "\t"))
    
25.     (setq Ty1 (strcat Y1 "\n"))
    
26.     (setq TXY (strcat TX1 Ty1))
    
27.     (setq n (+ n 1))
    
28.     (setq J1 (strcat "J" (itoa n) "\t"))
    
29.     (setq JXY (strcat J1 TXY))
    
30.     (setq JXY1 (strcat JXY1 JXY))
    
31.   )
    
32.   (setq wjyh1 JXY1)
    
33.   (write-line wjyh1 file1)
    
34.   (alert wjyh1)
    
35.   (princ)
    
36.   (close file1)
    
37.   (princ)
    
38. )
    
39. 
    
40. ;;;功能：向系统剪贴板写入文字
    
41. (defun SET-CLIP-STRING (STR / HTML RESULT)
    
42.     (and (= (type STR) 'STR)
    
43.    (setq HTML (vlax-create-object "htmlfile"))
    
44.    (setq RESULT (vlax-invoke
    
45.         (vlax-get (vlax-get HTML 'PARENTWINDOW)
    
46.             'CLIPBOARDDATA
    
47.         )
    
48.         'SETDATA
    
49.         "Text"
    
50.         STR
    
51.           )
    
52.    )
    
53.    (vlax-release-object HTML)
    
54.     )
    
55. )
    

(DEFUN C:44 (/ aa)<br />   (setq aa (car(entsel "\n选择多段线: ")))<br />   (getpt aa)<br />   (dcfc ptlst)<br />   (SET-CLIP-STRING wjyh1)<br /> (princ)<br /> )<br /> <br /> ;;获取坐标函数<br /> (defun getpt(ss)<br /> (setq ptlst (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) (entget ss))))<br /> )<br /> <br /> ;;把坐标值写入E盘的“坐标表值.txt”里<br /> (defun dcfc (ptlst / wjmdz file1 n JXY1 xy X1 y1 TX1 Ty1 TXY J1 JXY JXY1)<br />   (setq wjmdz (strcat "e:/坐标表值.txt"))<br />   (setq file1 (open wjmdz "w"))<br />   (setq n 0)<br />   (setq JXY1 (strcat ""))<br />   (repeat (length ptlst)<br />     (setq xy (nth n ptlst))<br />     (setq X1 (RTOS (cadr xy) 2 2))  ;每一组坐标依次求出X的字符<br />     (setq y1 (RTOS (car xy) 2 2))  ;每一组坐标依次求出Y的字符<br />     (setq TX1 (strcat X1 "\t"))<br />     (setq Ty1 (strcat Y1 "\n"))<br />     (setq TXY (strcat TX1 Ty1))<br />     (setq n (+ n 1))<br />     (setq J1 (strcat "J" (itoa n) "\t"))<br />     (setq JXY (strcat J1 TXY))<br />     (setq JXY1 (strcat JXY1 JXY))<br />   )<br />   (setq wjyh1 JXY1)<br />   (write-line wjyh1 file1)<br />   (alert wjyh1)<br />   (princ)<br />   (close file1)<br />   (princ)<br /> )<br /> <br /> ;;;功能：向系统剪贴板写入文字<br /> (defun SET-CLIP-STRING (STR / HTML RESULT)<br />     (and (= (type STR) 'STR)<br />    (setq HTML (vlax-create-object "htmlfile"))<br />    (setq RESULT (vlax-invoke<br />         (vlax-get (vlax-get HTML 'PARENTWINDOW)<br />             'CLIPBOARDDATA<br />         )<br />         'SETDATA<br />         "Text"<br />         STR<br />           )<br />    )<br />    (vlax-release-object HTML)<br />     )<br /> )<br />

逍遥无声

正好需要

注册

有没有可以直接从txt坐标直接在CAD中画出轮廓封闭线---

664571221

注册 发表于 2022-7-24 09:49
有没有可以直接从txt坐标直接在CAD中画出轮廓封闭线---

cass可以啊....