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

song宋_74729

在线等高手帮忙解决 谢谢

guosheyang

圆弧 半径 好提取吧； 两切线交点也好办，分别求圆弧两端点与圆心连线的角度  角度加减90度  用polar 计算切线上的一个点， 然后用inters 函数 求交点即可

guosheyang

院长都给你写出来了  输出到Excel 论坛也有代码  自己搜下

song宋_74729

xyp1964 发表于 2022-3-17 12:38
(defun ArcBreakPoint (s1 / p0 p1 p1a p2 p2a pt) ;圆弧拐点函数
  (setq p0  (cdr (assoc 10 (entget s1 ...

(vl-load-com)
defun c:tt
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

guosheyang 发表于 2022-3-18 14:51
院长都给你写出来了  输出到Excel 论坛也有代码  自己搜下

执行发现错误

xyp1964

song宋_74729 发表于 2022-3-18 15:44
执行发现错误

1. (defun c:tt ()
   
2.   (defun dxf (code e) (cdr (assoc code (entget e))))
   
3.   (defun ArcBreakPoint (s1 / p0 p1 p1a p2 p2a pt) ;
   
4.     (setq p0  (cdr (assoc 10 (entget s1)))
   
5.           p1  (vlax-curve-getStartPoint s1)
   
6.           p2  (vlax-curve-getEndPoint s1)
   
7.           p1a (polar p1 (+ (angle p0 p1) (* pi 0.5)) 1)
   
8.           p2a (polar p2 (+ (angle p0 p2) (* pi 0.5)) 1)
   
9.     )
   
10.     (inters p1 p1a p2 p2a nil)
    
11.   )
    
12.   (if (setq ss (ssget '((0 . "arc"))))
    
13.     (progn
    
14.       (setq i        -1
    
15.             lst        '()
    
16.       )
    
17.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
18.         (setq pt  (ArcBreakPoint s1)
    
19.               a          (list (cadr pt) (car pt) (dxf 40 s1))
    
20.               a          (mapcar '(lambda (x) (rtos x 2 3)) a)
    
21.               lst (cons a lst)
    
22.         )
    
23.       )
    
24.       (setq lst (cons '("X=" "Y=" "圆弧半径") (reverse lst)))
    
25.       (print lst)
    
26.     )
    
27.   )
    
28.   (princ)
    
29. )
    

(defun c:tt ()<br />   (defun dxf (code e) (cdr (assoc code (entget e))))<br />   (defun ArcBreakPoint (s1 / p0 p1 p1a p2 p2a pt) ;<br />     (setq p0  (cdr (assoc 10 (entget s1)))<br />           p1  (vlax-curve-getStartPoint s1)<br />           p2  (vlax-curve-getEndPoint s1)<br />           p1a (polar p1 (+ (angle p0 p1) (* pi 0.5)) 1)<br />           p2a (polar p2 (+ (angle p0 p2) (* pi 0.5)) 1)<br />     )<br />     (inters p1 p1a p2 p2a nil)<br />   )<br />   (if (setq ss (ssget '((0 . "arc"))))<br />     (progn<br />       (setq i        -1<br />             lst        '()<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq pt  (ArcBreakPoint s1)<br />               a          (list (cadr pt) (car pt) (dxf 40 s1))<br />               a          (mapcar '(lambda (x) (rtos x 2 3)) a)<br />               lst (cons a lst)<br />         )<br />       )<br />       (setq lst (cons '("X=" "Y=" "圆弧半径") (reverse lst)))<br />       (print lst)<br />     )<br />   )<br />   (princ)<br /> )<br />

song宋_74729

xyp1964 发表于 2022-3-18 21:35

谢谢xyp1964版主,如何将数据提取至execl,每一个点加编号,1. X=  Y=  R=  

并标注在图上,才知道提取位置

谢谢

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))
)
)
)
)
如何修改为图上标注编号并提
取圆弧首末坐标及交点坐标 半径
谢谢

夏生生

可以看看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

夏生生 发表于 2022-4-4 15:43
可以看看vlax-curve-getfirstderiv函数

改为图上标注编号并提
取圆弧首末坐标及交点坐标 半径
夏生生 谢谢