乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 73|回复: 5

求区域面积!!!

[复制链接]

12

主题

37

帖子

4

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
85
发表于 2004-5-14 14:30:00 | 显示全部楼层 |阅读模式
是我编的小程序:谢谢指导!!(defun c:tt()
(setq a(getpoint"\n点区域"))
(command "boundary" a "" "Y")
(setq b(entlast))
(command "area" "O" b)
(setq c (getvar "AREA"))
(command "text" a 3 0 (rtos c))
(command "ERASE" b "")
)
回复

使用道具 举报

15

主题

114

帖子

6

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
174
发表于 2004-5-14 14:47:00 | 显示全部楼层
不错挺使用的
回复

使用道具 举报

6

主题

23

帖子

2

银币

初来乍到

Rank: 1

铜币
47
发表于 2004-5-14 18:57:00 | 显示全部楼层
region也能行吗??
回复

使用道具 举报

63

主题

1203

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1455
发表于 2004-5-15 08:21:00 | 显示全部楼层
我在書上找到一個, 也是蠻不錯的哦.         給大火參考參考 呵呵(defun c:lsp_45()
         (setvar "cmdecho" 0)
         (setq pt (getpoint "\n選取點:"))
         (while pt
                         (setvar "cecolor" "1")
                         (command "bpoly" pt "")
                         (setq en (entlast))
                         (if en
                                         (progn
        (command "area" "o" en)
        (setq aa (getvar "area"))
        (redraw en 3)
        (alert (strcat "面積=" (rtos aa 2)))))
                         (entdel en)
                         (setvar "cecolor" "bylayer")
                         (setq pt (getpoint "\n選取點:"))
                         )
         (princ))
回复

使用道具 举报

43

主题

152

帖子

6

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
324
发表于 2004-5-15 23:07:00 | 显示全部楼层
我也编了一个,请指教:
(defun c:area2 ()
(setvar "cmdecho" 0)
(command "_.undo" "be")
(setq pt (getpoint "\n面积自动计算并标注 VER 1.0---by Rokin!\n请点取要标注的范围内一点:"))
(command "-boundary" pt "")
(command "area" "o" (entlast))
(command "erase" (entlast) "")
(setq area (getvar "area"))
(command "style" "幼圆" "幼圆" "" "" "" "" "")
(command "text" "j" "c" pt "250" "0" (strcat (rtos (/ area 1000000) 2 3) "M"))
(princ (strcat "\n该范围的面积为A=" (rtos (/ area 1000000) 2 3) "M" (strcat "(" (rtos area 2 0) "mm)。") "\n***面积自动计算并标注--ver 1.0***(2004年2月 by Rokin)!\n"))
(command "_.undo" "e")
(setvar "cmdecho" 1)
(princ))
回复

使用道具 举报

20

主题

872

帖子

10

银币

中流砥柱

Rank: 25

铜币
952
发表于 2004-5-16 00:26:00 | 显示全部楼层
有点bug,当点中实体或非封闭区域,后面就不正常了。修改一下:
  1. (defun c:aaa(/ oc occ enl pt en)
  2.    (mapcar 'set '(oc occ) (mapcar 'getvar '("cmdecho" "cecolor")))
  3.    (mapcar 'setvar '("cmdecho" "cecolor") '(0 "1"))
  4.    (setq enl (entlast))
  5.    (while (setq pt (getpoint "\n选点:"))
  6.        (if (and (vl-cmdf "bpoly" pt "")(not(equal enl (setq en (entlast)))))
  7.                (progn (command "area" "o" en)
  8.                              (alert (strcat "面积=" (rtos (getvar "area") 2)))
  9.                              (entdel en)
  10.                )
  11.        )
  12.    )
  13.    (mapcar 'setvar '("cmdecho" "cecolor") (list oc occ))
  14.    (princ)
  15. )
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-8-16 22:23 , Processed in 1.977715 second(s), 64 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表