hushiyong11 发表于 2021-9-13 16:23:34

展开相贯线的问题

本帖最后由 hushiyong11 于 2021-9-13 16:32 编辑

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

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

图片还不会改插入位置
以下是代码：
(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 发表于 2021-9-14 08:51:43

自己顶一下

夏生生 发表于 2021-9-14 10:12:34

算法是不是有问题

start4444 发表于 2021-9-14 10:38:02

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

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

夏生生 发表于 2021-9-14 11:00:49

本帖最后由 夏生生 于 2021-9-14 11:09 编辑

感觉你的算法不对，不过我也不是专业的，您试试
(defun c:xgx (/ r1 r2 ang n pt x1 i lst x y make-lwpl)
(setq      r1(getreal "\n主管半径:")
      r2(getreal "\n支管半径:")
      ang (getangle "\n夹角:")
      n   (getint "\n等分数:")
      pt(getpoint "\n插入点:")
)
(setq      x1 (/ pi (* 0.5 n))
      i0
)
(repeat (1+ n)
    (setq x (* i x1))
    (setq y (/ (+ (* r2 (cos x) (cos ang))
                  (sqrt (- (* r1 r1) (expt (* r2 (sin x)) 2)))
               )
               (sin ang)
            )
    )
    (setq i   (1+ i)
          lst (cons (list (* r2 x) y) lst)
    )
)
(make-lwpl
    (mapcar '(lambda (x)
               (mapcar '+
                     (list (car pt) (- (cadr pt) (cadr (last lst))))
                     x
               )
             )
            lst
    )
    0
    0
)
(defun make-lwpl (plist mode w / ocs ed)
    (setq ocs (trans '(0 0 1) 1 0 t))
    (setq ed (list (cons 0 "LWPOLYLINE")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbPolyline")
                   (cons 90 (length plist))
                   (cons 70 mode)
                   (cons 43 w)
             )
    )
    (foreach elem plist
      (setq
      ed (append ed
                   (list (cons 10 (trans elem 1 ocs))
                   )
         )
      )
    )
    (setq ed (append ed (list (cons 210 ocs))))
    (entmakex ed)
)
)

hushiyong11 发表于 2021-9-14 17:26:30

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 17:29:24

本帖最后由 hushiyong11 于 2021-9-14 17:50 编辑

夏生生 发表于 2021-9-14 11:00
感觉你的算法不对，不过我也不是专业的，您试试
您的代码里有好多函数我还没用过，我还差的多
代码里有一段需要调整一下，可以完美运行，谢谢指导
页: [1]
查看完整版本: 展开相贯线的问题