复杂的几何算法—求斜矩形的四角点位

ynhh

求斜矩形的四角点位
红色正矩形框为已知并固定的尺寸
ABCD为倾斜的矩形，并且四角点各自在红色矩形框上
AB平行DC并且长度相等
斜矩形中的
BC
AD
两个长度相等但是可以变化的


求：ABCD点位置？
谢谢大师的指点

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:求斜矩形的四角点位.zip 
下载次数:6  文件大小:12.38 KB 
下载权限: 不限 以上  [免费赚D豆]

coverne

这个需要挺特别

ynhh

斜矩形中的
BC
AD
长度是可变化的

Lisphk

求AB 两个端点的垂线和红色矩形的交点，连起来就是

ynhh

Lisphk 发表于 2019-3-6 11:00
求AB 两个端点的垂线和红色矩形的交点，连起来就是

谢谢大师的指点
能不能写个代码来
验证一下
谢谢

naruto018

像这样?

ynhh

naruto018 发表于 2019-3-7 09:14
像这样?

你这应不是提前标注好C=50吧
能不能发代码来学习分享一下
你标价分享
谢谢

Lisphk

ynhh 发表于 2019-3-7 11:04
你这应不是提前标注好C=50吧
能不能发代码来学习分享一下
你标价分享

他是得到结果了，然后画出标注，再运行次，让你看清楚。

naruto018

源码

[sell=3]

1. (defun c:tt2 ( / p1 p2 c p0 pmin pmax a b a1 a2 b1 b2 tf
   
2.              p1-1 p1-2 p1-3 p1-4 )
   
3.     (setq p1 (getpoint "\nP1:")
   
4.           p2 (getcorner p1 "\nP2:")
   
5.           c (getreal "\nc:"))
   
6.     (setq p0 (K:point-mia (list p1 p2))
   
7.           pmin (car p0)
   
8.           pmax (cadr p0)
   
9.           b (- (car pmax) (car pmin))
   
10.           a (- (cadr pmax) (cadr pmin))
    
11.           a1 1e-4)
    
12.     (while (and
    
13.                (<= a1 (/ a 2))
    
14.                (not (setq TF (equal
    
15.                         (* a1 (- a a1))
    
16.                         (* (setq b2 (K:triangle-one c a1))
    
17.                            (- b b2))
    
18.                         1e-1))))
    
19.         (setq a1 (+ a1 1e-4))
    
20.         );_while
    
21.     (if (and a1 b2 tf)
    
22.         (progn
    
23.             (setq b1 (- b b2)
    
24.                   a2 (- a a1))
    
25.             (setq p1-1 (mapcar '+
    
26.                                pmin
    
27.                                (list b1
    
28.                                      0))
    
29.                   p1-2 (mapcar '-
    
30.                                pmax
    
31.                                (list 0
    
32.                                      a2))
    
33.                   p1-3 (mapcar '-
    
34.                                pmax
    
35.                                (list b1
    
36.                                      0))
    
37.                   p1-4 (mapcar '+
    
38.                                pmin
    
39.                                (list 0
    
40.                                      a2))
    
41.                   )
    
42.             (command "PLINE" p1-1 p1-2 p1-3 p1-4 "C")
    
43.             ) ;_progn
    
44.         (prompt "\n**NO FOUND**")
    
45.         );_if
    
46.     (prompt "\n**END**")
    
47.     (princ)
    
48.     ) ;_END
    
49. 
    
50. (defun K:point-mia ( pts / )
    
51.     (mapcar
    
52.         (function
    
53.             (lambda (operation)
    
54.                 (apply 'mapcar (cons operation pts))
    
55.                 )
    
56.             )
    
57.         '(min max)
    
58.         )
    
59.     );_END
    
60. 
    
61. (defun K:triangle-one ( a b / )
    
62.     (sqrt (abs (- (expt a 2)
    
63.                   (expt b 2))))
    
64.     );_END
    

(defun c:tt2 ( / p1 p2 c p0 pmin pmax a b a1 a2 b1 b2 tf<br />              p1-1 p1-2 p1-3 p1-4 )<br />     (setq p1 (getpoint "\nP1:")<br />           p2 (getcorner p1 "\nP2:")<br />           c (getreal "\nc:"))<br />     (setq p0 (K:point-mia (list p1 p2))<br />           pmin (car p0)<br />           pmax (cadr p0)<br />           b (- (car pmax) (car pmin))<br />           a (- (cadr pmax) (cadr pmin))<br />           a1 1e-4)<br />     (while (and<br />                (<= a1 (/ a 2))<br />                (not (setq TF (equal<br />                         (* a1 (- a a1))<br />                         (* (setq b2 (K:triangle-one c a1))<br />                            (- b b2))<br />                         1e-1))))<br />         (setq a1 (+ a1 1e-4))<br />         );_while<br />     (if (and a1 b2 tf)<br />         (progn<br />             (setq b1 (- b b2)<br />                   a2 (- a a1))<br />             (setq p1-1 (mapcar '+<br />                                pmin<br />                                (list b1<br />                                      0))<br />                   p1-2 (mapcar '-<br />                                pmax<br />                                (list 0<br />                                      a2))<br />                   p1-3 (mapcar '-<br />                                pmax<br />                                (list b1<br />                                      0))<br />                   p1-4 (mapcar '+<br />                                pmin<br />                                (list 0<br />                                      a2))<br />                   )<br />             (command "PLINE" p1-1 p1-2 p1-3 p1-4 "C")<br />             ) ;_progn<br />         (prompt "\n**NO FOUND**")<br />         );_if<br />     (prompt "\n**END**")<br />     (princ)<br />     ) ;_END<br /> <br /> (defun K:point-mia ( pts / )<br />     (mapcar<br />         (function<br />             (lambda (operation)<br />                 (apply 'mapcar (cons operation pts))<br />                 )<br />             )<br />         '(min max)<br />         )<br />     );_END<br /> <br /> (defun K:triangle-one ( a b / )<br />     (sqrt (abs (- (expt a 2)<br />                   (expt b 2))))<br />     );_END<br />

[/sell]
找不到回复可见
将就收个费吧

ynhh

naruto018 发表于 2019-3-7 13:27
源码

**** 本内容需购买可见 ****

谢谢您的指点
我晚上学习领会一下
衷心感谢您

ynhh

naruto018 发表于 2019-3-7 13:27
源码

**** 本内容需购买可见 ****

昨晚试了
的确精确好用
就是有点慢费时间
衷心感谢您
向您致敬

还有点小请求
1、能不能把精度改小一点（或是误差再大一点如0.01),让速度快一些
2，如何设置能让斜矩形也可成为右边高左边低（也就是现在的左右朝向互换）

谢谢您高超的技术指点

naruto018

ynhh 发表于 2019-3-8 09:23
昨晚试了
的确精确好用
就是有点慢费时间

1.只要调高(setq a1 (+ a1 1e-4))的1e-4-->1e-2
以及稍微改(equal 的误差值1e-1-->1e0
就可以了
不然可以试试用长或宽以一定比例做为递增值
以防止长或宽过大
导致运算过久

2.简单的左右相反
只要改
p1-1 p1-2 p1-3 p1-4的点计算中
a2改a1
b1改b2

最近有点忙
没有太多的研究

Lisphk

ynhh 发表于 2019-3-8 09:23
昨晚试了
的确精确好用
就是有点慢费时间

不复杂的操作，怎么会慢呢？

ynhh

Lisphk 发表于 2019-3-8 11:11
不复杂的操作，怎么会慢呢？

不是操作慢
是运算费时间
电脑反应慢
谢谢您

ynhh

naruto018 发表于 2019-3-8 10:52
1.只要调高(setq a1 (+ a1 1e-4))的1e-4-->1e-2
以及稍微改(equal 的误差值1e-1-->1e0
就可以了

谢谢您
祝您
工作顺利
身体健康