展开相贯线的问题

hushiyong11

代码功能：展开主管与支管交叉处的相贯线（目前代码求出的坐标还不完美，还在完善）

问题：可以计算出各点的坐标，无法绘出图形

图片还不会改插入位置
以下是代码：
(defun c:zk(/ pt n dist1 dist2 rad1 rad2 ang x y yy)
;;;计算半径
  (setq rad1 (/ (getreal "输入主管直径:") 2))
  (setq rad2 (/ (getreal "输入支管直径:") 2))
  (setq n (getint "输入等分数:"))
  (setq ang (/ 360 n))
  (setq y 0)
  ;;;计算出点坐标并画出多段线
  (repeat n
    (setq x (cos (*(/ (* ang pi) 180) y)))
    (setq dist1 (* rad2 x))
    (setq dist2 (sqrt (- (* rad1 rad1) (* dist1 dist1))))
    (setq yy (list dist2 (* y (/ (* rad2 pi) n))))
    (command "_.pline" yy )
    (setq y (1+ y))
    )
   )

hushiyong11

自己顶一下

夏生生

算法是不是有问题

start4444

帮你把先画出来，点位算法你自己完善

(defun c:tt5(/ ang dist1 dist2 n pt ptbs ptlst rad1 rad2 x y yy)
;;;计算半径
  (setq rad1 (/ (getreal "输入主管直径:") 2))
  (setq rad2 (/ (getreal "输入支管直径:") 2))
  (setq n (getint "输入等分数:"))
  (setq ang (/ 360 n))
  (setq y 0)
        (setq ptbs (getpoint"\n选择基点:") ptlst '())
  ;;;计算出点坐标并组成表
  (repeat n
    (setq x (cos (*(/ (* ang pi) 180) y)))
    (setq dist1 (* rad2 x))
    (setq dist2 (sqrt (- (* rad1 rad1) (* dist1 dist1))))
    (setq yy (list (+ (car ptbs) dist2) (+ (cadr ptbs) (* y (/ (* rad2 pi) n)))))
    ;(command "_.pline" yy )
                (setq ptlst (cons yy ptlst))
    (setq y (1+ y))
    )
        ;表->多段线
        (Make-LWPOLYLINE ptlst)
        (princ)
   )

(defun Make-LWPOLYLINE (lst / PT);;点表->多段线
  (entmake (append (list '(0 . "LWPOLYLINE")
                                                                                 '(100 . "AcDbEntity")
                                                                                 '(100 . "AcDbPolyline")
                                                                                 (cons 90 (length lst))
                   )
                                                 (mapcar '(lambda (pt) (cons 10 pt)) lst)
           )
  )
)

夏生生

感觉你的算法不对，不过我也不是专业的，您试试

2. (defun c:xgx (/ r1 r2 ang n pt x1 i lst x y make-lwpl)
   
3.   (setq        r1  (getreal "\n主管半径:")
   
4.         r2  (getreal "\n支管半径:")
   
5.         ang (getangle "\n夹角:")
   
6.         n   (getint "\n等分数:")
   
7.         pt  (getpoint "\n插入点:")
   
8.   )
   
9.   (setq        x1 (/ pi (* 0.5 n))
   
10.         i  0
    
11.   )
    
12.   (repeat (1+ n)
    
13.     (setq x (* i x1))
    
14.     (setq y (/ (+ (* r2 (cos x) (cos ang))
    
15.                   (sqrt (- (* r1 r1) (expt (* r2 (sin x)) 2)))
    
16.                )
    
17.                (sin ang)
    
18.             )
    
19.     )
    
20.     (setq i   (1+ i)
    
21.           lst (cons (list (* r2 x) y) lst)
    
22.     )
    
23.   )
    
24.   (make-lwpl
    
25.     (mapcar '(lambda (x)
    
26.                (mapcar '+
    
27.                        (list (car pt) (- (cadr pt) (cadr (last lst))))
    
28.                        x
    
29.                )
    
30.              )
    
31.             lst
    
32.     )
    
33.     0
    
34.     0
    
35.   )
    
36.   (defun make-lwpl (plist mode w / ocs ed)
    
37.     (setq ocs (trans '(0 0 1) 1 0 t))
    
38.     (setq ed (list (cons 0 "LWPOLYLINE")
    
39.                    (cons 100 "AcDbEntity")
    
40.                    (cons 100 "AcDbPolyline")
    
41.                    (cons 90 (length plist))
    
42.                    (cons 70 mode)
    
43.                    (cons 43 w)
    
44.              )
    
45.     )
    
46.     (foreach elem plist
    
47.       (setq
    
48.         ed (append ed
    
49.                    (list (cons 10 (trans elem 1 ocs))
    
50.                    )
    
51.            )
    
52.       )
    
53.     )
    
54.     (setq ed (append ed (list (cons 210 ocs))))
    
55.     (entmakex ed)
    
56.   )
    
57. )

(defun c:xgx (/ r1 r2 ang n pt x1 i lst x y make-lwpl)<br />   (setq        r1  (getreal "\n主管半径:")<br />         r2  (getreal "\n支管半径:")<br />         ang (getangle "\n夹角:")<br />         n   (getint "\n等分数:")<br />         pt  (getpoint "\n插入点:")<br />   )<br />   (setq        x1 (/ pi (* 0.5 n))<br />         i  0<br />   )<br />   (repeat (1+ n)<br />     (setq x (* i x1))<br />     (setq y (/ (+ (* r2 (cos x) (cos ang))<br />                   (sqrt (- (* r1 r1) (expt (* r2 (sin x)) 2)))<br />                )<br />                (sin ang)<br />             )<br />     )<br />     (setq i   (1+ i)<br />           lst (cons (list (* r2 x) y) lst)<br />     )<br />   )<br />   (make-lwpl<br />     (mapcar '(lambda (x)<br />                (mapcar '+<br />                        (list (car pt) (- (cadr pt) (cadr (last lst))))<br />                        x<br />                )<br />              )<br />             lst<br />     )<br />     0<br />     0<br />   )<br />   (defun make-lwpl (plist mode w / ocs ed)<br />     (setq ocs (trans '(0 0 1) 1 0 t))<br />     (setq ed (list (cons 0 "LWPOLYLINE")<br />                    (cons 100 "AcDbEntity")<br />                    (cons 100 "AcDbPolyline")<br />                    (cons 90 (length plist))<br />                    (cons 70 mode)<br />                    (cons 43 w)<br />              )<br />     )<br />     (foreach elem plist<br />       (setq<br />         ed (append ed<br />                    (list (cons 10 (trans elem 1 ocs))<br />                    )<br />            )<br />       )<br />     )<br />     (setq ed (append ed (list (cons 210 ocs))))<br />     (entmakex ed)<br />   )<br /> )

hushiyong11

start4444 发表于 2021-9-14 10:38
帮你把先画出来，点位算法你自己完善

(defun c:tt5(/ ang dist1 dist2 n pt ptbs ptlst rad1 rad2 x y y ...

感谢您的指导，您的代码我已测试，运行成功

hushiyong11

夏生生 发表于 2021-9-14 11:00
感觉你的算法不对，不过我也不是专业的，您试试

您的代码里有好多函数我还没用过，我还差的多
代码里有一段需要调整一下，可以完美运行，谢谢指导