(已解决)叉路口圆弧如何求出交点

夏生生

song宋_74729 发表于 2022-4-4 16:02
改为图上标注编号并提
取圆弧首末坐标及交点坐标 半径
夏生生 谢谢

您拿19楼的改改就是了，就是那么几个函数转圈圈

1. (defun c:tt (/ en f i lst n pt pt1 pt1a pt2 pt2a r ss)
   
2.   (setq ss (ssget '((0 . "arc"))))
   
3.   (repeat (setq i (sslength ss))
   
4.     (setq n    (* 3 i)
   
5.     en   (ssname ss (setq i (1- i)))
   
6.     r    (rtos (cdr (assoc 40 (entget en))) 2 3)
   
7.     pt1  (vlax-curve-getstartpoint en)
   
8.     pt1a (mapcar '+
   
9.            pt1
   
10.            (vlax-curve-getfirstderiv
    
11.        en
    
12.        (vlax-curve-getparamatpoint en pt1)
    
13.        )
    
14.            )
    
15.     pt2  (vlax-curve-getendpoint en)
    
16.     pt2a (mapcar '-
    
17.            pt2
    
18.            (vlax-curve-getfirstderiv
    
19.        en
    
20.        (vlax-curve-getparamatpoint en pt2)
    
21.        )
    
22.            )
    
23.     pt   (trans (inters pt1 pt1a pt2 pt2a nil) 0 1)
    
24.     pt1  (trans pt1 0 1)
    
25.     pt2  (trans pt2 0 1)
    
26.     lst  (cons (strcat (itoa n)
    
27.            ","
    
28.            (rtos (car pt) 2 3)
    
29.            ","
    
30.            (rtos (cadr pt) 2 3)
    
31.            ","
    
32.            r
    
33.            ",心"
    
34.            )
    
35.          lst
    
36.          )
    
37.     lst  (cons (strcat (itoa (1- n))
    
38.            ","
    
39.            (rtos (car pt2) 2 3)
    
40.            ","
    
41.            (rtos (cadr pt2) 2 3)
    
42.            ","
    
43.            r
    
44.            ",末"
    
45.            )
    
46.          lst
    
47.          )
    
48.     lst  (cons (strcat (itoa (- n 2))
    
49.            ","
    
50.            (rtos (car pt1) 2 3)
    
51.            ","
    
52.            (rtos (cadr pt1) 2 3)
    
53.            ","
    
54.            r
    
55.            ",首"
    
56.            )
    
57.          lst
    
58.          )
    
59.     )
    
60.     (entmake
    
61.       (list '(0 . "circle") (cons 10 (trans pt 1 0)) (cons 40 1))
    
62.       )
    
63.     (entmake (list '(0 . "text")
    
64.        '(100 . "AcDbEntity")
    
65.        '(100 . "AcDbText")
    
66.        (cons 10 (trans pt 1 0))
    
67.        (cons 1 (itoa n))
    
68.        (cons 40 1)
    
69.        )
    
70.        )
    
71.     (entmake (list '(0 . "text")
    
72.        '(100 . "AcDbEntity")
    
73.        '(100 . "AcDbText")
    
74.        (cons 10 (trans pt2 1 0))
    
75.        (cons 1 (itoa (1- n)))
    
76.        (cons 40 1)
    
77.        )
    
78.        )
    
79.     (entmake (list '(0 . "text")
    
80.        '(100 . "AcDbEntity")
    
81.        '(100 . "AcDbText")
    
82.        (cons 10 (trans pt1 1 0))
    
83.        (cons 1 (itoa (- n 2)))
    
84.        (cons 40 1)
    
85.        )
    
86.        )
    
87.     )
    
88.   (setq f (open "d:\\1.csv" "w"))
    
89.   (foreach n (cons "序号,X=,Y=,半径,点类别" lst)
    
90.     (write-line n f)
    
91.     )
    
92.   (close f)
    
93.   )

(defun c:tt (/ en f i lst n pt pt1 pt1a pt2 pt2a r ss)<br />   (setq ss (ssget '((0 . "arc"))))<br />   (repeat (setq i (sslength ss))<br />     (setq n    (* 3 i)<br />     en   (ssname ss (setq i (1- i)))<br />     r    (rtos (cdr (assoc 40 (entget en))) 2 3)<br />     pt1  (vlax-curve-getstartpoint en)<br />     pt1a (mapcar '+<br />            pt1<br />            (vlax-curve-getfirstderiv<br />        en<br />        (vlax-curve-getparamatpoint en pt1)<br />        )<br />            )<br />     pt2  (vlax-curve-getendpoint en)<br />     pt2a (mapcar '-<br />            pt2<br />            (vlax-curve-getfirstderiv<br />        en<br />        (vlax-curve-getparamatpoint en pt2)<br />        )<br />            )<br />     pt   (trans (inters pt1 pt1a pt2 pt2a nil) 0 1)<br />     pt1  (trans pt1 0 1)<br />     pt2  (trans pt2 0 1)<br />     lst  (cons (strcat (itoa n)<br />            ","<br />            (rtos (car pt) 2 3)<br />            ","<br />            (rtos (cadr pt) 2 3)<br />            ","<br />            r<br />            ",心"<br />            )<br />          lst<br />          )<br />     lst  (cons (strcat (itoa (1- n))<br />            ","<br />            (rtos (car pt2) 2 3)<br />            ","<br />            (rtos (cadr pt2) 2 3)<br />            ","<br />            r<br />            ",末"<br />            )<br />          lst<br />          )<br />     lst  (cons (strcat (itoa (- n 2))<br />            ","<br />            (rtos (car pt1) 2 3)<br />            ","<br />            (rtos (cadr pt1) 2 3)<br />            ","<br />            r<br />            ",首"<br />            )<br />          lst<br />          )<br />     )<br />     (entmake<br />       (list '(0 . "circle") (cons 10 (trans pt 1 0)) (cons 40 1))<br />       )<br />     (entmake (list '(0 . "text")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbText")<br />        (cons 10 (trans pt 1 0))<br />        (cons 1 (itoa n))<br />        (cons 40 1)<br />        )<br />        )<br />     (entmake (list '(0 . "text")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbText")<br />        (cons 10 (trans pt2 1 0))<br />        (cons 1 (itoa (1- n)))<br />        (cons 40 1)<br />        )<br />        )<br />     (entmake (list '(0 . "text")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbText")<br />        (cons 10 (trans pt1 1 0))<br />        (cons 1 (itoa (- n 2)))<br />        (cons 40 1)<br />        )<br />        )<br />     )<br />   (setq f (open "d:\\1.csv" "w"))<br />   (foreach n (cons "序号,X=,Y=,半径,点类别" lst)<br />     (write-line n f)<br />     )<br />   (close f)<br />   )

song宋_74729

感谢 夏生生 问题解决了