[求助]LISP能求出双椭圆公切线端点吗？

highflybird · 发表于 2010-9-1 11:06:00

本帖最后由作者于 2010-9-2 8:33:58 编辑

别这样夸我。我会飘飘然的。明经上高人多的是。呵呵，这就是我为什么喜欢来这里的缘故。
你说的竖椭圆，实际上是椭圆的长轴旋转了90度。

(vl-load-com)
(prompt "\n选取两个椭圆，第一个椭圆必须正置放.")
(defun c:ccc (/ A1 B1 C1 CEN D1 D2 DIV E1 E2 EPS O1 O2 SOL MAJ)
(setq eps 1e-8)
(setq e1 (car (entsel)))
(setq e2 (car (entsel)))
(if (and e1
e1
(setq d1 (entget e1))
(setq d2 (entget e2))
(= (cdr (assoc 0 d1)) "ELLIPSE")
(= (cdr (assoc 0 d2)) "ELLIPSE")
)
(progn
(setq d1 (entget e1))
(setq d2 (entget e2))
(setq a1 (distance '(0 0 0) (cdr (assoc 11 d1))))
(setq b1 (* a1 (cdr (assoc 40 d1))))
(setq cen (cdr (assoc 10 d1)))
(setq maj (cdr (assoc 11 d1)))
(setq maj (mapcar '/ maj (list a1 a1 a1)))
(setq ang (angle '(0 0 0) maj))
(setq nor (cdr (assoc 210 d1)))
(setq o1 (vlax-ename->vla-object e1))
(setq o2 (vlax-ename->vla-object e2))
(if (or (equal (angle '(0 0) maj) (* pi 0.5) eps)
(equal (angle '(0 0) maj) (* pi 1.5) eps)
)
(setq c1 a1
a1 b1
b1 c1
)
)
(setq div 50)
(setq sol (find o2 a1 b1 cen div))
(foreach n sol
(bsol (car n) (cdr n) o2 a1 b1 cen eps mat)
)
)
)
(princ)
)

(vl-load-com)
(prompt "\n选取两个椭圆，第一个椭圆必须正置放.")
(defun c:ccc (/ A1 B1 C1 CEN D1 D2 DIV E1 E2 EPS O1 O2 SOL MAJ)
  (setq eps 1e-8)
  (setq e1 (car (entsel)))
  (setq e2 (car (entsel)))
  (if (and e1
    e1
    (setq d1 (entget e1))
    (setq d2 (entget e2))
    (= (cdr (assoc 0 d1)) "ELLIPSE")
    (= (cdr (assoc 0 d2)) "ELLIPSE")
      )
    (progn
      (setq d1 (entget e1))
      (setq d2 (entget e2))
      (setq a1 (distance '(0 0 0) (cdr (assoc 11 d1))))
      (setq b1 (* a1 (cdr (assoc 40 d1))))
      (setq cen (cdr (assoc 10 d1)))
      (setq maj (cdr (assoc 11 d1)))
      (setq maj (mapcar '/ maj (list a1 a1 a1)))
      (setq ang (angle '(0 0 0) maj))
      (setq nor (cdr (assoc 210 d1)))
      (setq o1 (vlax-ename->vla-object e1))
      (setq o2 (vlax-ename->vla-object e2))

(if (or (equal (angle '(0 0) maj) (* pi 0.5) eps)
       (equal (angle '(0 0) maj) (* pi 1.5) eps)
   )
 (setq c1 a1
       a1 b1
       b1 c1
 )
      )
      
      (setq div 50)
      (setq sol (find o2 a1 b1 cen div))
      (foreach n sol
 (bsol (car n) (cdr n) o2 a1 b1 cen eps mat)
      )
    )
  )
  (princ)
)

关于第一种方法，有几个错误，我已经做了修正。请重新下载附件

highflybird · 发表于 2010-9-2 22:22:00

给出最后的程序。即使两个椭圆是旋转的，或者在UCS下，也能正确给出答案。

实际上本程序给出的思路也可求一般曲线的公切线。

没有严格出错处理，有需要的请自行加上.

HRQ28 · 发表于 2010-9-4 10:15:00

highflybird大师您的程序真是很伟大，我试用了感谢无比的佩服。
有个想法请您看看，如再略改一下，在目前可通用于两个椭圆的情况下，也改为可通用于两个圆或一个椭圆另一个为圆。这样是不是就应用起来很方便了。
请您再试试看。

highflybir · 发表于 2010-9-9 11:20:00

本帖最后由作者于 2010-9-10 14:45:06 编辑

修改了一下，没来得及测试，应该可以用于椭圆和圆，

呵呵，测试一下如何在发帖中用明经的金钱规则。

dkj0322 · 发表于 2010-9-9 13:56:00

谢谢了，很厉害啊@

flowerson · 发表于 2010-9-12 18:05:00

还有数学几何的，好深奥啊？

zark · 发表于 2011-5-14 21:07:55

高飞大师，我一直关注你的贴子，请多多发贴哦

690994 · 发表于 2012-3-13 17:30:06

本帖最后由 690994 于 2012-3-13 17:30 编辑

高飞大师确是高人，艺高德更高，

hnzz0808 · 发表于 2015-12-18 08:21:35

都是高手！！！

账号		自动登录	找回密码
密码			注册

[求助]LISP能求出双椭圆公切线端点吗？

本帖子中包含更多资源

[原创]两条曲线的公切线的求法

本帖子中包含更多资源