[1201]怎样编写一个梯形的面积计算列式呢?

tctabc

[1201]怎样编写梯形、三角形、弧形的面积计算列式?
想要的结果是
假设图形为梯形形状物件且为封闭的聚合线形
当选取后可以使用 公式:上底加下底*高/2
计算后列出此计算过程并使用 text 显示于图面上
这样的程序可以实现吗?
烦请各位高手帮忙解答
谢谢

测试用CAD文件。by xyp1964[/COLOR]

gewanjia

我有一个简陋算法：选取4个边后，通过两两直线是否平行 判断上下底，然后用直线距离函数
算出上下底边长，通过两底算高-》带入公式。我看过好像没有直接算的函数

taner

如果是現成的圖形,不需要公式.
不記得哪位大蝦編的如下的東東.
[php](defun c:mj (/ pt)
  (while (setq pt (getpoint "点击区域..."))
    (command "_.boundary" "a" "o" "p" "" pt "")
    (command "_.area" "o" (entlast))
    (entdel (entlast))
    (prompt "\n")
    (prompt (rtos (getvar "area")))
  )
  (princ)
)[/php]

或:

[php]
(defun test (/ obj mj)
  (setq obj (entsel "\n請選擇封閉實體:"))
  (setq mj (vlax-curve-getarea (car obj)))
  (princ "\n所選實體面積爲:")
  mj
)[/php]

xyz518mm

taner楼主您说的对
但因工作需要配合图说列计算式检查所以不能用系统查询
因此想撰写这程序来用看看~
希望各位能帮忙解答一下
谢谢

taner

最初由 xyz518mm 发布
[B]taner楼主您说的对
但因工作需要配合图说列计算式检查所以不能用系统查询
因此想撰写这程序来用看看~
希望各位能帮忙解答一下
谢谢 [/B]

沒有明白你說的意思?

xyz518mm

例如说纸张图面上有一个矩形是长10宽10
那列出的计算式就要有 10*10=100 的面积计算过程.
而不是直接标上他的面积
所以我希望这工作可以透过程式来完成.

tctabc

最初由 xyz518mm 发布
[B]taner楼主您说的对
但因工作需要配合图说列计算式检查所以不能用系统查询
因此想撰写这程序来用看看~
希望各位能帮忙解答一下
谢谢 [/B]

xyz518mm 楼主也是从事土建相关行业的吧
我也是相关行业
也是因为老板要求你的面积怎样算出来的
总老不能说你看电脑吧!!!
所以需要再图面上写上计算式给老板或业主看
希望各位能理解

xyp1964

此主题表面看似简单，实际较难，盼望大家快快出手！加币！

实例：

xyp1964

这样是否也可以？

xyz518mm

xyp1964 版大果真是厲害阿
不知道開頭要怎樣做呢?
另外這問題似乎只是我之前題問中的一小部份問題,請見http://p4.xdcad.net/forum/showth ... 2424056#post2424056
內有程序
不過是一小段不能執行
可以看看觀念

xyp1964

删除多段线中直线段的多余点

2. [FONT=courier new](load "xyp_lib.vlx")                        ;版本 V.20051202 (1756)
   
3. ;|加载通用函数(可在签名栏直接下载)
   
4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
   
5. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
6. ★1·在acad.lsp中增加(load"xyp_lib")
   
7. ■2·在每个程序内增加(load"xyp_lib")
   
8. ■3·在command下，输入(load"xyp_lib")
   
9. ■4·在菜单.mnl中增加(load"xyp_lib")
   
10. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
    
11. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
12. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
13. |;
    
14. 
    
15. ;;;删除多段线中直线段的多余点
    
16. (defun c:test ()
    
17.   (CMDLA0)
    
18.   (setvar "osmode" 0)
    
19.   (setq        ss  (ssget '((0 . "*POLYLINE")))
    
20.         s1  (ssname ss 0)
    
21.         ptn (xyp-get-Vertexes s1 T)
    
22.         ptn (xyp-get-VertexesTrue ptn)
    
23.         pt1 (xyp-get-MinMaxPoint s1 1)
    
24.         pt9 (xyp-get-MinMaxPoint s1 9)
    
25.   )
    
26.   (mkla "test" 1)
    
27.   (command "pline")
    
28.   (foreach pt ptn (command pt))
    
29.   (if (or (= (xyp-get-dxf 70 s1) 1)
    
30.           (equal (xyp-get-CurveEndPoint s1)
    
31.                  (xyp-get-CurveStartPoint s1)
    
32.           )
    
33.       )
    
34.     (command "c")
    
35.     (command "")
    
36.   )
    
37.   (setq s2 (entlast))
    
38.   (command "move"
    
39.            s2
    
40.            ""
    
41.            pt1
    
42.            (list (car pt9) (cadr pt1))
    
43.   )
    
44.   (CMDLA1)
    
45. )[/FONT]

[FONT=courier new](load "xyp_lib.vlx")                        ;版本 V.20051202 (1756)<br /> ;|加载通用函数(可在签名栏直接下载)<br /> 如果已经下载xyp_lib并放到搜索路径下可以不再下载!<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib")<br /> ■2·在每个程序内增加(load"xyp_lib")<br /> ■3·在command下，输入(load"xyp_lib")<br /> ■4·在菜单.mnl中增加(load"xyp_lib")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> |;<br /> <br /> ;;;删除多段线中直线段的多余点<br /> (defun c:test ()<br />   (CMDLA0)<br />   (setvar "osmode" 0)<br />   (setq        ss  (ssget '((0 . "*POLYLINE")))<br />         s1  (ssname ss 0)<br />         ptn (xyp-get-Vertexes s1 T)<br />         ptn (xyp-get-VertexesTrue ptn)<br />         pt1 (xyp-get-MinMaxPoint s1 1)<br />         pt9 (xyp-get-MinMaxPoint s1 9)<br />   )<br />   (mkla "test" 1)<br />   (command "pline")<br />   (foreach pt ptn (command pt))<br />   (if (or (= (xyp-get-dxf 70 s1) 1)<br />           (equal (xyp-get-CurveEndPoint s1)<br />                  (xyp-get-CurveStartPoint s1)<br />           )<br />       )<br />     (command "c")<br />     (command "")<br />   )<br />   (setq s2 (entlast))<br />   (command "move"<br />            s2<br />            ""<br />            pt1<br />            (list (car pt9) (cadr pt1))<br />   )<br />   (CMDLA1)<br /> )[/FONT]

taner

最初由 xyp1964 发布
[B]这样是否也可以？ [/B]

先將梯形聚合:

[PHP](defun c:test (/ h interspoint l1 l2 mj polygon pt1 pt2 pt3 pt4 ptlist
                 str
              )
  (setq ptlist (massoc 10 (entget (car (setq polygon (entsel "\n請點選梯形:"))))))
  (setq mj (vlax-curve-getarea (car polygon)))
  (setq pt1 (nth 0 ptlist)
        pt2 (nth 1 ptlist)
        pt3 (nth 2 ptlist)
        pt4 (nth 3 ptlist)
  )
  (if (setq interspoint (inters
                          pt1
                          pt2
                          pt3
                          pt4
                          nil
                        )
      )
    (if (setq interspoint (inters
                            pt1
                            pt3
                            pt2
                            pt4
                            nil
                          )
        )
      (setq l1 (max
                 (distance pt1 pt4)
                 (distance pt2 pt3)
               )
            l2 (min
                 (distance pt1 pt4)
                 (distance pt2 pt3)
               )
      )
    )
    (setq l1 (max
               (distance pt1 pt2)
               (distance pt3 pt4)
             )
          l2 (min
               (distance pt1 pt2)
               (distance pt3 pt4)
             )
    )
  )
  (setq h (/ (* mj 2) (+ l1 l2)))
  (setq str (strcat "L1=" (rtos l1) "&L2=" (rtos l2) "&H="
                    (rtos h) "&S=(" (rtos l1) "+" (rtos l2) ")*"
                    (rtos h) "/2=" (rtos mj)
            )
  )
  (command "TEXT" "J" "C" interspoint "" "" str)
(princ)
)[/PHP]
測試:
test  效果如圖

xyp1964

POLYLINE实体的dxf 组码10：(10 0.0 0.0 0.0)，出错！
也应付不了11楼的情况。

先发个编译版（再次修改）的来试试：

狂刀

ｘｙｐ，我测试怎么老说不是梯形呢？

发一个自己写的，
支持多点梯形多义线，
支持多义线起点任意位置．
自动识别梯形
支持预选
可指定文字标注位置．
命令：txbz

狂刀

演示