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

song宋_74729

叉路口圆弧如何求出交点,

红色圈为交点,可以用框选方式求出

圆弧与交点坐标和半径,并汇出至EXECL,

麻烦大神帮忙谢谢.

夏生生

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 />   )

夏生生

可以看看vlax-curve-getfirstderiv函数

1. (defun c:tt (/ en f i lst n pt pt1 pt1a pt2 pt2a ss)
   
2.   (setq ss (ssget '((0 . "arc"))))
   
3.   (repeat (setq i (sslength ss))
   
4.     (setq en   (ssname ss (setq i (1- i)))
   
5.       pt1  (vlax-curve-getstartpoint en)
   
6.       pt1a (mapcar '+
   
7.                pt1
   
8.                (vlax-curve-getfirstderiv
   
9.              en
   
10.              (vlax-curve-getparamatpoint en pt1)
    
11.              )
    
12.                )
    
13.       pt2  (vlax-curve-getendpoint en)
    
14.       pt2a (mapcar '-
    
15.                pt2
    
16.                (vlax-curve-getfirstderiv
    
17.              en
    
18.              (vlax-curve-getparamatpoint en pt2)
    
19.              )
    
20.                )
    
21.       pt   (trans (inters pt1 pt1a pt2 pt2a nil) 0 1)
    
22.       n    (itoa (1+ i))
    
23.       lst  (cons (strcat n
    
24.                  ","
    
25.                  (rtos (car pt) 2 3)
    
26.                  ","
    
27.                  (rtos (cadr pt) 2 3)
    
28.                  ","
    
29.                  (rtos (cdr (assoc 40 (entget en))) 2 3)
    
30.                  )
    
31.              lst
    
32.              )
    
33.       )
    
34.     (entmake
    
35.       (list '(0 . "circle") (cons 10 (trans pt 1 0)) (cons 40 1))
    
36.       )
    
37.     (entmake (list '(0 . "text")
    
38.            '(100 . "AcDbEntity")
    
39.            '(100 . "AcDbText")
    
40.            (cons 10 (trans pt 1 0))
    
41.            (cons 1 n)
    
42.            (cons 40 1)
    
43.            )
    
44.          )
    
45.     )
    
46.   (setq f (open "d:\\1.csv" "w"))
    
47.   (foreach n lst
    
48.     (write-line n f)
    
49.     )
    
50.   (close f)
    
51.   )

(defun c:tt (/ en f i lst n pt pt1 pt1a pt2 pt2a ss)<br />   (setq ss (ssget '((0 . "arc"))))<br />   (repeat (setq i (sslength ss))<br />     (setq en   (ssname ss (setq i (1- i)))<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 />       n    (itoa (1+ i))<br />       lst  (cons (strcat n<br />                  ","<br />                  (rtos (car pt) 2 3)<br />                  ","<br />                  (rtos (cadr pt) 2 3)<br />                  ","<br />                  (rtos (cdr (assoc 40 (entget en))) 2 3)<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 n)<br />            (cons 40 1)<br />            )<br />          )<br />     )<br />   (setq f (open "d:\\1.csv" "w"))<br />   (foreach n lst<br />     (write-line n f)<br />     )<br />   (close f)<br />   )

song宋_74729

song宋_74729 发表于 2022-3-18 23:00
谢谢xyp1964版主,如何将数据提取至execl,每一个点加编号,1. X=  Y=  R=  并标注在图上,才知道提取位置谢 ...

(defun c:tt ()
  (defun dxf (code e) (cdr (assoc code (entget e))))
  (defun ArcBreakPoint (s1 / p0 p1 p1a p2 p2a pt) ;
    (setq p0  (cdr (assoc 10 (entget s1)))
          p1  (vlax-curve-getStartPoint s1)
          p2  (vlax-curve-getEndPoint s1)
          p1a (polar p1 (+ (angle p0 p1) (* pi 0.5)) 1)
          p2a (polar p2 (+ (angle p0 p2) (* pi 0.5)) 1)
    )
    (inters p1 p1a p2 p2a nil)
  )
  (if (setq ss (ssget '((0 . "arc"))))
    (progn
      (setq i        -1
            lst        '()
      )
      (while (setq s1 (ssname ss (setq i (1+ i))))
        (setq pt  (ArcBreakPoint s1)
              a          (list (cadr pt) (car pt) (dxf 40 s1))
              a          (mapcar '(lambda (x) (rtos x 2 3)) a)
              lst (cons a lst)
        )
      )
      (setq lst (cons '("X=" "Y=" "圓弧半徑") (reverse lst)))
      (print lst)
    )
  )
  (princ)
)
(setq ffn (getfiled "坐標寫入文本文件" "D:/" "TXT" 1))
(setq opf (open ffn "w"))
(setq ss (ssget '((0 . "*ARC"))))
(setq kg " ")
(setq txt (strcat  kg "X坐標" kg "Y坐標" kg "圓弧半徑"))
(write-line txt opf)
;(princ (strcat kg "X坐標" kg "Y坐標" kg "圓弧半徑") opf)
(setq i -1)
(setq key 10)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i)))))
(setq count 1)
(foreach xy ent
(if (eq (car xyr) key)
(progn
(setq pe (cdr xyr))
(setq x (rtos(cadr pe)2 3))
(setq y (rtos(car pe)2 3))
(setq r (rtos(caddr pe)2 3))
(write-line (strcat (itoa count) kg x kg y kg r) opf)
;(princ "\n" opf)
;(princ (strcat (itoa count) kg x kg y kg r) opf)
(setq count (1+ count))
)
)
)
)
如何修改为图上标注编号并提
取圆弧首末坐标及交点坐标 半径
谢谢

guosheyang

没咋说清楚，红色小圆为交点，啥交点？那些圆弧与红色小圆哪有啥交点？  既然都画好了，还需要求？直接导出就可以

song宋_74729

guosheyang 发表于 2022-3-17 11:40
没咋说清楚，红色小圆为交点，啥交点？那些圆弧与红色小圆哪有啥交点？  既然都画好了，还需要求？直接导出 ...

红色圈为圆弧交点,交点是未知,

guosheyang

圆弧与圆弧的交点？还是圆弧与啥的交点？

song宋_74729

guosheyang 发表于 2022-3-17 11:59
圆弧与圆弧的交点？还是圆弧与啥的交点？

单圆弧交点

xyp1964

(defun ArcBreakPoint (s1 / p0 p1 p1a p2 p2a pt) ;圆弧拐点函数
  (setq p0  (cdr (assoc 10 (entget s1)))
        p1  (vlax-curve-getStartPoint s1)
        p2  (vlax-curve-getEndPoint s1)
        p1a (polar p1 (+ (angle p0 p1) (* pi 0.5)) 1)
        p2a (polar p2 (+ (angle p0 p2) (* pi 0.5)) 1)
  )
  (inters p1 p1a p2 p2a nil)
)

song宋_74729

xyp1964 发表于 2022-3-17 12:38
(defun ArcPtR (s1 / p0 p1 p1a p2 p2a pt)
  (setq        p0  (cdr (assoc 10 (entget s1)))
        p ...

厉害 , 那圆圈的交点是未知的,我要求出圆弧及交点坐标和半径,汇出至execl

guosheyang

红色圆圈和圆弧是啥关系？为何称为交点？

guosheyang

哦  懂了  原来是两端点的切线交点

song宋_74729

guosheyang 发表于 2022-3-17 13:12
哦  懂了  原来是两端点的切线交点

没错 就是两端点的切线交点