提取点号生成坐标文件T1234T

树櫴希德

1. ;(jiaodujuli (getpoint) (getpoint))
   
2. ;(myassoc (car(entsel)) 10) jiaodujuli
   
3. (defun jiaodujuli (pt1 pt2 / jiaodu  juli )
   
4.   (setq pt1 (vl-remove (last pt1)pt1))
   
5.   (setq pt2 (vl-remove (last pt2)pt2))
   
6.     (setq jiaodu (angle pt1 pt2))
   
7.     (setq juli (distance pt1 pt2))
   
8. (list jiaodu  juli )
   
9.   )
   
10. 
    
11. (defun 10zu (e /)
    
12. (cdr(assoc 10 (entget e)))
    
13.   )
    
14. (defun 1zu (e /)
    
15. (cdr(assoc 1 (entget e)))
    
16.   )
    
17. 
    
18. (defun 0zu (e /)
    
19. (cdr(assoc 0 (entget e)))
    
20.   )
    
21. 
    
22. (defun SstoEs(ss / a en lst)
    
23.   (if ss(progn(setq a -1)
    
24.    (while(setq en(ssname ss(setq a(1+ a))))
    
25.      (setq lst(cons en lst)))))
    
26.   lst)
    
27. 
    
28. (defun myassoc(e code / a b)
    
29.   (setq e(entget e))
    
30.   (while(setq a(assoc code e))
    
31.     (setq b(cons a b)e(vl-remove a e)))
    
32.   (mapcar'cdr(reverse b))
    
33.   )
    
34. 
    
35. (defun c:tt(/ fp s m p h a)
    
36.   (setq fp(getfiled "打开数据文件" "C:\\" "dat" 36)
    
37.   fp(if fp(open fp"a")))
    
38.   (setq s(sstoes(ssget"X"'((0 . "LWPOLYLINE")(8 . "0"))))m 0 a "")
    
39.   (repeat (length s)
    
40.     (setq p(myassoc(nth m s)10)m(1+ m)
    
41.     p(list(/(+(caar p)(caadr p))2)(/(+(cadar p)(cadadr p))2)))
    
42.     (setq h(vl-sort(sstoes(ssget"CP"(list(setq p1(polar p 3.14 3.5))(setq p2(polar p1 1.57 2))(polar p2 0 5.5)(polar p 0 2))'((0 . "TEXT")(8 . "桩号"))))
    
43.        (function(lambda(e1 e2)(<(cadr(assoc 10(entget e1)))(cadr(assoc 10(entget e2)))))))
    
44.     h(mapcar'(lambda(x)(cdr(assoc 1(entget x))))h)
    
45.     h(if(=(length h)2)(strcat(car h)"."(cadr h))(car h)))
    
46.     (setq a(strcat a(itoa m)",,"(rtos (car p)2 3)","(rtos (cadr p)2 3)","h"\n")))
    
47.   (write-line a fp)
    
48.   (close fp))
    
49. ;; 创建直线图元
    
50. (defun NewLine:pt1-pt2 (pt1 pt2)
    
51.   (entmake (list '(0 . "LINE")
    
52.              (cons 10 pt1)
    
53.              (cons 11 pt2)
    
54.      (cons 62 3)
    
55.            )
    
56.   )
    
57. )
    
58. 
    
59. 
    
60. 
    
61. 
    
62. ;(nentselp (getpoint))
    
63. ;(1zu (car(entsel )))
    
64. ;(0zu (car(entsel )))
    
65. (defun c:t1234t ( / fp s m p hhh a  pt1 pt2 jiaodu  juli kk x  )  ;  
    
66.   (setq fp(getfiled "打开数据文件" "C:\\" "dat" 36)
    
67.   fp(if fp(open fp"a")))
    
68.   (setq pt1 (getpoint "\n 请指定圆心点："))
    
69.   (setq pt2 (getpoint "\n 请指定文字中间点："))
    
70. 
    
71.   (setq jiaodu (car (jiaodujuli pt1 pt2  )))
    
72.   (setq juli (cadr (jiaodujuli pt1 pt2  )))
    
73.   (setq s(sstoes(ssget'((0 . "circle")(8 . "00 路基段工艺"))))
    
74.   m 0
    
75.   a "")
    
76.    (repeat (length s)
    
77.      (setq p(10zu (nth m s)))  ;(10zu (nth 0 s))
    
78.      (setq kk (list (car (polar p jiaodu juli) ) (cadr (polar p jiaodu juli) ) ) )
    
79. 
    
80.   (setq hhh(vl-remove nil (mapcar  '(lambda (x)    (if (equal (0zu x) "TEXT" )  (1zu x)     )  )    (sstoes(ssget "F" (list  (list (car p) (cadr p))  kk (polar p (angle kk p) juli) )) )   )))  ;(polar p (angle kk p) juli)这句可以删除好点
    
81. 
    
82.      
    
83.                ;( NewLine:pt1-pt2  (list (car p) (cadr p))  kk)
    
84.    ;(setq  h  (1zu(car(nentselp "" kk ))  )   )
    
85.      
    
86.   (setq   m(1+ m) )
    
87.      
    
88.      (setq a(strcat (car hhh) ",," (rtos (car p)2 3) "," (rtos (cadr p)2 3) "," (rtos (caddr p)2 3) ))
    
89.   (write-line a fp)
    
90.     (setq p nil) (setq kk nil) (setq h nil)
    
91.      )
    
92. 
    
93. (close fp)
    
94.       (princ)
    
95. 
    
96.   )

;(jiaodujuli (getpoint) (getpoint))<br /> ;(myassoc (car(entsel)) 10) jiaodujuli<br /> (defun jiaodujuli (pt1 pt2 / jiaodu  juli )<br />   (setq pt1 (vl-remove (last pt1)pt1))<br />   (setq pt2 (vl-remove (last pt2)pt2))<br />     (setq jiaodu (angle pt1 pt2))<br />     (setq juli (distance pt1 pt2))<br /> (list jiaodu  juli )<br />   )<br /> <br /> (defun 10zu (e /)<br /> (cdr(assoc 10 (entget e)))<br />   )<br /> (defun 1zu (e /)<br /> (cdr(assoc 1 (entget e)))<br />   )<br /> <br /> (defun 0zu (e /)<br /> (cdr(assoc 0 (entget e)))<br />   )<br /> <br /> (defun SstoEs(ss / a en lst)<br />   (if ss(progn(setq a -1)<br />    (while(setq en(ssname ss(setq a(1+ a))))<br />      (setq lst(cons en lst)))))<br />   lst)<br /> <br /> (defun myassoc(e code / a b)<br />   (setq e(entget e))<br />   (while(setq a(assoc code e))<br />     (setq b(cons a b)e(vl-remove a e)))<br />   (mapcar'cdr(reverse b))<br />   )<br /> <br /> (defun c:tt(/ fp s m p h a)<br />   (setq fp(getfiled "打开数据文件" "C:\\" "dat" 36)<br />   fp(if fp(open fp"a")))<br />   (setq s(sstoes(ssget"X"'((0 . "LWPOLYLINE")(8 . "0"))))m 0 a "")<br />   (repeat (length s)<br />     (setq p(myassoc(nth m s)10)m(1+ m)<br />     p(list(/(+(caar p)(caadr p))2)(/(+(cadar p)(cadadr p))2)))<br />     (setq h(vl-sort(sstoes(ssget"CP"(list(setq p1(polar p 3.14 3.5))(setq p2(polar p1 1.57 2))(polar p2 0 5.5)(polar p 0 2))'((0 . "TEXT")(8 . "桩号"))))<br />        (function(lambda(e1 e2)(<(cadr(assoc 10(entget e1)))(cadr(assoc 10(entget e2)))))))<br />     h(mapcar'(lambda(x)(cdr(assoc 1(entget x))))h)<br />     h(if(=(length h)2)(strcat(car h)"."(cadr h))(car h)))<br />     (setq a(strcat a(itoa m)",,"(rtos (car p)2 3)","(rtos (cadr p)2 3)","h"\n")))<br />   (write-line a fp)<br />   (close fp))<br /> ;; 创建直线图元<br /> (defun NewLine:pt1-pt2 (pt1 pt2)<br />   (entmake (list '(0 . "LINE")<br />              (cons 10 pt1)<br />              (cons 11 pt2)<br />      (cons 62 3)<br />            )<br />   )<br /> )<br /> <br /> <br /> <br /> <br /> ;(nentselp (getpoint))<br /> ;(1zu (car(entsel )))<br /> ;(0zu (car(entsel )))<br /> (defun c:t1234t ( / fp s m p hhh a  pt1 pt2 jiaodu  juli kk x  )  ;  <br />   (setq fp(getfiled "打开数据文件" "C:\\" "dat" 36)<br />   fp(if fp(open fp"a")))<br />   (setq pt1 (getpoint "\n 请指定圆心点："))<br />   (setq pt2 (getpoint "\n 请指定文字中间点："))<br /> <br />   (setq jiaodu (car (jiaodujuli pt1 pt2  )))<br />   (setq juli (cadr (jiaodujuli pt1 pt2  )))<br />   (setq s(sstoes(ssget'((0 . "circle")(8 . "00 路基段工艺"))))<br />   m 0<br />   a "")<br />    (repeat (length s)<br />      (setq p(10zu (nth m s)))  ;(10zu (nth 0 s))<br />      (setq kk (list (car (polar p jiaodu juli) ) (cadr (polar p jiaodu juli) ) ) )<br /> <br />   (setq hhh(vl-remove nil (mapcar  '(lambda (x)    (if (equal (0zu x) "TEXT" )  (1zu x)     )  )    (sstoes(ssget "F" (list  (list (car p) (cadr p))  kk (polar p (angle kk p) juli) )) )   )))  ;(polar p (angle kk p) juli)这句可以删除好点<br /> <br />      <br />                ;( NewLine:pt1-pt2  (list (car p) (cadr p))  kk) <br />    ;(setq  h  (1zu(car(nentselp "" kk ))  )   )<br />      <br />   (setq   m(1+ m) )<br />      <br />      (setq a(strcat (car hhh) ",," (rtos (car p)2 3) "," (rtos (cadr p)2 3) "," (rtos (caddr p)2 3) ))<br />   (write-line a fp)<br />     (setq p nil) (setq kk nil) (setq h nil)<br />      )<br /> <br /> (close fp)<br />       (princ)<br /> <br />   )

寒潮大冬瓜

很好→很棒！很好~很棒！！很好……很棒！！！