[求助]：面积长度转化为平方米、米

aozero · 发表于 2007-1-30 14:06:03

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

请问：
可以在工具栏输入一个命令，能得出线段或封闭的长度面积吗，单位是米、平方米。
谢谢！！！

zml84 · 发表于 2007-1-31 14:46:06

楼主的意思是自定义一个命令用于查询封闭对象的特性，是完全可以实现的。
但是图上数值单位如何提前确定？

aozero · 发表于 2007-1-31 21:57:55

谢谢回复！
我的意思是原图纸设定的单位是毫米，我现在想直接用命令测量出来的面积或者长度单位为平米、米。
谢谢！

zml84 · 发表于 2007-2-2 15:19:56

定义命令"T".
[PHP]
(defun c:t ()
  (princ "\n★★查询长度、面积\n★★默认CAD单位为毫米")
  (while
(= (setq el (entsel "\n请点选实体：")) nil)
  )
  (setq ent  (entget (car el) '("*"))
类型 (cdr (assoc '0 ent))
  )
  (princ "\n★对象类型：")
  (princ 类型)

  (cond
((= 类型 "LINE")
   (progn
   (setq pt0  (cdr (assoc '10 ent))
      pt1  (cdr (assoc '11 ent))
      长度 (distance pt0 pt1)
   )
   (princ "，长度：")
   (princ (/ 长度 1000))
   (princ " 米")
   )
)
((= 类型 "CIRCLE")
   (progn
   (setq r    (cdr (assoc '40 ent))
      周长 (* 2.0 pi r)
      面积 (* pi r r)
   )
   (princ "，周长：")
   (princ (/ 周长 1000))
   (princ " 米")
   (princ "，面积：")
   (princ (/ 面积 1000000))
   (princ " 平方米")
   )
)
((= 类型 "LWPOLYLINE")
   (progn
   (setvar "CMDECHO" 0)
   (command "_list" el "")
   (graphscr)
   (setq l (getvar "PERIMETER")
      a (getvar "AREA")
   )
   (princ "\n★对象类型：")
   (princ 类型)
   (princ "，长度：")
   (princ (/ l 1000))
   (princ " 米")
   (princ "，面积：")
   (princ (/ a 1000000))
   (princ " 平方米")
   )
)
(t
   (princ "，不能识别！！")
)
  )
  (princ)
)

[/PHP]
如果感觉不好用的话，请跟贴说一声。

武陵山人 · 发表于 2007-2-4 00:40:27

不能识别椭圆、椭圆弧及SPL线，能否改进一下？

zml84 · 发表于 2007-2-4 15:18:15

改进后，可以识别直线、圆、圆弧、多段线、多义线、面域、椭圆等。
[PHP]
;;;===========================================================
;;;  查询单个图元长度、面积信息
;;;
;;;　日　期：zml84 于2007-02-04
;;;===========================================================
(defun c:t (/ bl el ent 类型 pt0 pt1 r jd0 jd1 jd l a)
(princ "\n★★查询长度、面积\n★★默认CAD单位为毫米")
;;设置比例
(setq bl 1000)
(while
(= (setq el (entsel "\n请点选实体：")) nil)
)
(setq ent  (entget (car el) '("*"))
   类型 (cdr (assoc '0 ent))
)
(princ "\n \n★对象类型：")
(princ 类型)

(cond
((= 类型 "LINE")
   (progn
      (setq pt0 (cdr (assoc '10 ent))
   pt1 (cdr (assoc '11 ent))
   l (distance pt0 pt1)
      )
      (princ "，长度：")
      (princ (/ l bl))
      (princ " 米")
   )
)

((= 类型 "CIRCLE")
   (progn
      (setq r (cdr (assoc '40 ent))
   l (* 2.0 pi r)
   a (* pi r r)
      )
      (princ "，周长：")
      (princ (/ l bl))
      (princ " 米")
      (princ "，面积：")
      (princ (/ a bl bl))
      (princ " 平方米")
   )
)

((= 类型 "ARC")
   (progn
      (setq r (cdr (assoc '40 ent))
   jd0 (cdr (assoc '50 ent))
   jd1 (cdr (assoc '51 ent))
      )
      (if (< jd1 jd0)
   (setq jd (- (+ jd1 pi pi) jd0))
   (setq jd (- jd1 jd0))
      )
      (setq l (* r jd))
      (princ "，长度：")
      (princ (/ l bl))
      (princ " 米")
   )
)

((or
      (= 类型 "LWPOLYLINE")
      (= 类型 "SPLINE")
      (= 类型 "ELLIPSE")
      (= 类型 "REGION")
   )
   (progn
      (setvar "CMDECHO" 0)
      (command "_AREA" "O" el)
      (setq l (getvar "PERIMETER")
   a (getvar "AREA")
      )
      (princ "，长度：")
      (princ (/ l bl))
      (princ " 米")
      (princ "，面积：")
      (princ (/ a bl bl))
      (princ " 平方米")
   )
)

(t
   (princ "，不能识别！！")
)
)
(princ)
)
;;;===========================================================
(princ "\n\n★★查询长度、面积\n★★键入命令\"T\"开始执行。")
(princ)
;;;===========================================================
[/PHP]

oyxx_1023 · 发表于 2007-2-4 15:43:45

R2K以上用一句就行了.

<font face="Arial">(/ (vla-get-area (vlax-ename->vla-object (car(entsel)))) 1000000)</font>

复制代码

真龙天子 · 发表于 2007-2-4 18:08:25

对bhatch充填的实体无效

zml84 · 发表于 2007-2-5 10:10:04

修改后，填充也可以查询面积了。
[PHP]
;;;===========================================================
;;;  查询单个图元长度、面积信息
;;;
;;;　日　期：zml84 于2007-02-05
;;;===========================================================
(defun c:t (/ bl el ent 类型 pt0 pt1 r jd0 jd1 jd l a)
(princ "\n★★查询长度、面积\n★★默认CAD单位为毫米")
;;设置比例
(setq bl 1000)
(while
(= (setq el (entsel "\n请点选实体：")) nil)
)
(setq ent  (entget (car el) '("*"))
   类型 (cdr (assoc '0 ent))
)
(princ "\n \n★对象类型：")
(princ 类型)

(cond
((= 类型 "LINE")
   (progn
      (setq pt0 (cdr (assoc '10 ent))
         pt1 (cdr (assoc '11 ent))
         l (distance pt0 pt1)
      )
      (princ "，长度：")
      (princ (/ l bl))
      (princ " 米")
   )
)

((= 类型 "CIRCLE")
   (progn
      (setq r (cdr (assoc '40 ent))
         l (* 2.0 pi r)
         a (* pi r r)
      )
      (princ "，周长：")
      (princ (/ l bl))
      (princ " 米")
      (princ "，面积：")
      (princ (/ a bl bl))
      (princ " 平方米")
   )
)

((= 类型 "ARC")
   (progn
      (setq r (cdr (assoc '40 ent))
         jd0 (cdr (assoc '50 ent))
         jd1 (cdr (assoc '51 ent))
      )
      (if (< jd1 jd0)
      (setq jd (- (+ jd1 pi pi) jd0))
      (setq jd (- jd1 jd0))
      )
      (setq l (* r jd))
      (princ "，长度：")
      (princ (/ l bl))
      (princ " 米")
   )
)

((or
      (= 类型 "LWPOLYLINE")
      (= 类型 "SPLINE")
      (= 类型 "ELLIPSE")
      (= 类型 "REGION")
   )
   (progn
      (setvar "CMDECHO" 0)
      (command "_AREA" "O" el)
      (setq l (getvar "PERIMETER")
         a (getvar "AREA")
      )
      (princ "，长度：")
      (princ (/ l bl))
      (princ " 米")
      (princ "，面积：")
      (princ (/ a bl bl))
      (princ " 平方米")
   )
)

( (= 类型 "HATCH")
   (progn
      (setvar "CMDECHO" 0)
      (command "_list" el "")
      (graphscr)
      (setq a (getvar "AREA"))
      (princ "\n \n★对象类型：")
      (princ 类型)
      (princ "，面积：")
      (princ (/ a bl bl))
      (princ " 平方米")
   )
)

(t
   (princ "，不能识别！！")
)
)
(princ)
)
;;;===========================================================
(princ "\n\n★★查询长度、面积\n★★键入命令\"T\"开始执行。")
(princ)
;;;===========================================================
[/PHP]

ahill · 发表于 2007-3-28 11:20:42

我觉得还可以再深化一下，比如对一个封闭的区域，自动搜索边界，对边界线的长度和面积自动标注，就比较爽了。。。。只是针对我哈，因为我正在练习编一个这样的LSP。

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

[求助] [求助]：面积长度转化为平方米、米

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子