[讨论]画四边形如何改进

mmh1

4. (defun c:4j()
5. (setq pa (getpoint "\n 请输入三角形左下角点："))
6. (setq da (getreal "\n 请输入三角形底边:"))
7. (setq db (getreal "\n 请输入三角形第二边:"))  ;请输入三角形第二边:与"之间不能有空格，否则输入错误。
8. (setq dc (getreal "\n 请输入三角形第三边:"))
9. (setq de (getreal "\n 请输入三角形第四边:"))
10. (setq dd (getreal "\n 请输入三角形第五边:"))
11. (setq s (/ (+ da db dc) 2))             ;求S＝(da+db+dc)/2
12. (setq earea (sqrt (* s (- s da) (- s db) (- s dc))))  ;求面积area=s*(s-da)*(s-db)*(s-dc)^0.5
13. (setq h  (/ (* 2 earea) da))                 ;求三角形高 h=2*area/da
15. (setq pab (sqrt (-(* dc dc) (* h h))))        ;求高将底边分成的两部分的长度
16. (setq pba (sqrt (-(* db db) (* h h))))
17. (cond ((and  (< pab pba) (> pba da)) (setq angb (atan (/ h pab))) (setq angfinal (- pi angb)))
18.       ((and  (> pab da) (> pab pba)) (setq angb (atan (/ h pab))) (setq angfinal angb))
19.       ((and  (< pab da) (< pba da))  (setq angb (atan (/ h pab))) (setq angfinal angb))
20. )
22. (setq s1 (/ (+ de db dd) 2))             ;求S＝(da+db+dc)/2
23. (setq earea1 (sqrt (* s1 (- s1 db) (- s1 de) (- s1 dd))))  ;求面积area=s*(s-da)*(s-db)*(s-dc)^0.5
24. (setq h1  (/ (* 2 earea1) db))                 ;求三角形高 h=2*area/da
26. (setq pac (sqrt (-(* dd dd) (* h1 h1))))        ;求高将底边分成的两部分的长度
27. (setq pca (sqrt (-(* de de) (* h1 h1))))
28. (cond ((and  (< pab pba) (> pba da)) (setq angb1 (atan (/ h pba))) (setq angfinal2 angb1))
29.       ((and  (> pab da) (> pab pba)) (setq angb1 (atan (/ h pba))) (setq angfinal2 (- pi angb1)))
30.       ((and  (< pab da) (< pba da))  (setq angb1 (atan (/ h pba))) (setq angfinal2 angb1))
31. )
32. (cond ((and  (< pac pca) (> pca db)) (setq angc (atan (/ h1 pca))) (setq angfinal1 angc))
33.       ((and  (> pac db) (> pac pca)) (setq angc (atan (/ h1 pca))) (setq angfinal1 (- pi angc)))
34.       ((and  (< pac db) (< pca db))  (setq angc (atan (/ h1 pca))) (setq angfinal1 angc))
35. )
36. (setq ang1 (+ angfinal2 angfinal1))
37. (setq ang2 (- pi ang1))
38. (setq pb (polar pa 0 da))       ;求pb点
39. (setq pc (polar pa angfinal dc))
40. (setq pg (polar pb ang2 de))
41. (command "line" pa pb  "")
42. (command "line" pb pc  "")
43. (command "line" pc pa  "")
44. (command "line" pc pg  "")
45. (command "line" pb pg  "")
46. (princ ang1)
47. )

(defun c:4j() (setq pa (getpoint "\n 请输入三角形左下角点：")) (setq da (getreal "\n 请输入三角形底边:")) (setq db (getreal "\n 请输入三角形第二边:"))  ;请输入三角形第二边:与"之间不能有空格，否则输入错误。 (setq dc (getreal "\n 请输入三角形第三边:")) (setq de (getreal "\n 请输入三角形第四边:")) (setq dd (getreal "\n 请输入三角形第五边:")) (setq s (/ (+ da db dc) 2))             ;求S＝(da+db+dc)/2 (setq earea (sqrt (* s (- s da) (- s db) (- s dc))))  ;求面积area=s*(s-da)*(s-db)*(s-dc)^0.5 (setq h  (/ (* 2 earea) da))                 ;求三角形高 h=2*area/da (setq pab (sqrt (-(* dc dc) (* h h))))        ;求高将底边分成的两部分的长度 (setq pba (sqrt (-(* db db) (* h h)))) (cond ((and  (< pab pba) (> pba da)) (setq angb (atan (/ h pab))) (setq angfinal (- pi angb)))       ((and  (> pab da) (> pab pba)) (setq angb (atan (/ h pab))) (setq angfinal angb))       ((and  (< pab da) (< pba da))  (setq angb (atan (/ h pab))) (setq angfinal angb)) ) (setq s1 (/ (+ de db dd) 2))             ;求S＝(da+db+dc)/2 (setq earea1 (sqrt (* s1 (- s1 db) (- s1 de) (- s1 dd))))  ;求面积area=s*(s-da)*(s-db)*(s-dc)^0.5 (setq h1  (/ (* 2 earea1) db))                 ;求三角形高 h=2*area/da (setq pac (sqrt (-(* dd dd) (* h1 h1))))        ;求高将底边分成的两部分的长度 (setq pca (sqrt (-(* de de) (* h1 h1)))) (cond ((and  (< pab pba) (> pba da)) (setq angb1 (atan (/ h pba))) (setq angfinal2 angb1))       ((and  (> pab da) (> pab pba)) (setq angb1 (atan (/ h pba))) (setq angfinal2 (- pi angb1)))       ((and  (< pab da) (< pba da))  (setq angb1 (atan (/ h pba))) (setq angfinal2 angb1)) ) (cond ((and  (< pac pca) (> pca db)) (setq angc (atan (/ h1 pca))) (setq angfinal1 angc))       ((and  (> pac db) (> pac pca)) (setq angc (atan (/ h1 pca))) (setq angfinal1 (- pi angc)))       ((and  (< pac db) (< pca db))  (setq angc (atan (/ h1 pca))) (setq angfinal1 angc)) ) (setq ang1 (+ angfinal2 angfinal1)) (setq ang2 (- pi ang1)) (setq pb (polar pa 0 da))       ;求pb点 (setq pc (polar pa angfinal dc)) (setq pg (polar pb ang2 de)) (command "line" pa pb  "") (command "line" pb pc  "") (command "line" pc pa  "") (command "line" pc pg  "") (command "line" pb pg  "") (princ ang1) )

通过网上的代码修改成四边形的

如何简化？

有人提出说可以用圆，不过不会取 交点

lenlenq

 不明白楼主的意思。
直接点点就行了
(defun    c:4j ()
   (setq pa (getpoint "\n 请输入四边形第一个角点："))
   (setq pb (getpoint pa"\n 请输入四边形第二个角点："))
   (setq pc (getpoint pb"\n 请输入四边形第三个角点："))
   (setq pd (getpoint pc"\n 请输入四边形第四个角点："))
   (command "line" pa pb pc pd "c")
   (princ)
  )

露水2

我的第一个程序就是四边形

Daniel·邓邓邓

露水2 发表于 2010-6-18 23:05
我的第一个程序就是四边形

悄悄给我看看你的程序吧。

zml84

http://zml84.blog.sohu.com/55989437.html

yshf

2. 
   
3. ;画四边形  yshf
   
4. ;以四边形对角线的第一点为准，四条边顺时针排列
   
5. (defun c:4b()
   
6.     (defun jj(a b c / p s h)
   
7.        (setq p (* 0.5 (+ a b c))
   
8.              s (sqrt (* p (- p a) (- p b) (- p c)))
   
9.              h (/ (* 2.0 s) c)
   
10.              d (sqrt (- (* a a) (* h h)))
    
11.              p (atan h d)
    
12.        )
    
13.     )
    
14. 
    
15.     (setq cm (getvar "cmdecho")
    
16.           os (getvar "osmode")
    
17.     )
    
18.     (setvar "cmdecho" 0)
    
19.     (setvar "osmode" 33)
    
20.     (while (setq p1 (getpoint "\n四边形对角线的第一点<回车退出>:"))
    
21.         (if (setq p3 (getpoint p1 "\n四边形对角线的另一点所在方向:"))
    
22.             (if (and (setq djx (getdist "\n四边形对角线长度:"))
    
23.                      (setq a1 (getdist "\n四边形第1条边长度:"))
    
24.                      (setq b1 (getdist "\n四边形第2条边长度:"))
    
25.                      (setq a2 (getdist "\n四边形第3条边长度:"))
    
26.                      (setq b2 (getdist "\n四边形第4条边长度:"))
    
27.                 )
    
28.                 (progn
    
29.                     (setq aa (angle p1 p3)
    
30.                           p3 (polar p1 aa djx)
    
31.                           p2 (polar p1 (+ aa (jj a1 b1 djx)) a1)
    
32.                           p4 (polar p1 (- aa (jj b2 a2 djx)) b2)
    
33.                     )
    
34.                     (setvar "osmode" 0)
    
35.                     (command "_pline" p1 p2 p3 p4 "c")
    
36.                 )
    
37.            )
    
38.         )
    
39.         (setvar "osmode" 33)
    
40.     )
    
41.     (setvar "osmode" os)
    
42.     (setvar "cmdecho" cm)
    
43.     (princ)                          
    
44. )
    

<br /> ;画四边形  yshf<br /> ;以四边形对角线的第一点为准，四条边顺时针排列<br /> (defun c:4b()<br />     (defun jj(a b c / p s h)<br />        (setq p (* 0.5 (+ a b c))<br />              s (sqrt (* p (- p a) (- p b) (- p c)))<br />              h (/ (* 2.0 s) c)<br />              d (sqrt (- (* a a) (* h h)))<br />              p (atan h d)<br />        )<br />     )<br /> <br />     (setq cm (getvar "cmdecho")<br />           os (getvar "osmode")<br />     )<br />     (setvar "cmdecho" 0)<br />     (setvar "osmode" 33)<br />     (while (setq p1 (getpoint "\n四边形对角线的第一点<回车退出>:"))<br />         (if (setq p3 (getpoint p1 "\n四边形对角线的另一点所在方向:"))<br />             (if (and (setq djx (getdist "\n四边形对角线长度:"))<br />                      (setq a1 (getdist "\n四边形第1条边长度:"))<br />                      (setq b1 (getdist "\n四边形第2条边长度:"))<br />                      (setq a2 (getdist "\n四边形第3条边长度:"))<br />                      (setq b2 (getdist "\n四边形第4条边长度:"))<br />                 )<br />                 (progn<br />                     (setq aa (angle p1 p3)<br />                           p3 (polar p1 aa djx)<br />                           p2 (polar p1 (+ aa (jj a1 b1 djx)) a1)<br />                           p4 (polar p1 (- aa (jj b2 a2 djx)) b2)<br />                     )<br />                     (setvar "osmode" 0)<br />                     (command "_pline" p1 p2 p3 p4 "c")<br />                 )<br />            )<br />         )<br />         (setvar "osmode" 33)<br />     )<br />     (setvar "osmode" os)<br />     (setvar "cmdecho" cm)<br />     (princ)                          <br /> )<br />

bobojames-one

yshf 发表于 2012-7-12 18:38

给力，很好用