设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：标注面积的一个程序，求优化方法 ...
返回列表 发新帖
查看: 825|回复: 8

[求助] [求助]：标注面积的一个程序，求优化方法

[复制链接]
sandyhuahua
发表于 2008-1-2 17:06:03 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
我有一个标注面积、长度的小程序（原作者是highflybird），每次标注时需输入选择项及文字高度，但其实我通常只需标注面积，文字高度基本固定，可惜无法设定默认值，如果有一个选项能设定默认值就好了。
源程序如下：
;;;===================
;;;面积和长度统计程序
;;;highflybird kunming
;;;===================
(prompt "命令为:At")
(defun C:at (/ f     ss             l             i             SSarea  totlen  entlen
             ename   name    obj     text-S  text-L  insPt0  height
             insPt1  insPt2  text-1  text-2  *APP    *DOC    *MSP
            )
  (vl-load-com)
  (setq *APP (vlax-get-acad-object))
  (setq *DOC (vla-get-activeDocument *APP))
  (setq *MSP (vla-get-Modelspace *DOC))
  (initget 1 "1 2 3")
  (setq f (getkword "\n请输入你要统计的<1>面积<2>长度<3>两者:"))
  (if
    (and
      (setq ss (ssget))
      (setq insPt0 (getpoint "\n请输入文字插入点: "))
      (setq height (getdist "\n请输入文字高度:"))
    )
    (progn
      (setq l (sslength ss))
      (setq i 0)
      (setq SSarea 0)
      (setq totlen 0)
      (setq insPt1 (vlax-3d-point insPt0))
      (setq insPt2 (polar insPt0 (* 1.5 Pi) (* 1.5 height)))
      (setq insPt2 (vlax-3d-point insPt2))               
      (cond
        ( (= f "1")
          (repeat l
            (func-1)
            (func-2)
            (setq i (1+ i))
          )
          (setq text-S (strcat (convert1 SSarea 6) "平方米"));总面积为:小数后6位
          (vla-addtext *MSP text-S insPt1 height)
        )
        ( (= f "2")
          (repeat l
            (func-1)
            (func-3)
            (setq i (1+ i))
          )
          (setq text-L (strcat (convert1 totlen 3) "米"))    ;总长度为:小数后3位
          (vla-addtext *MSP text-L insPt2 height)
        )
        ( (= f "3")
          (repeat l
            (func-1)
            (func-2)
            (func-3)
            (setq i (1+ i))
          )
          (setq text-S (strcat (convert1 SSarea 6) "平方米"));总面积为:小数后6位
          (setq text-L (strcat (convert1 totlen 3) "米"))    ;总长度为:小数后3位
          (vla-addtext *MSP text-S insPt1 height)
          (vla-addtext *MSP text-L insPt2 height)
        )       
      )       
    )
    (alert "你没有选取物体或者输入正确的数据!")
  )
  (princ)
)
(defun func-1 ()
  (setq ename (ssname ss i))
  (setq obj (vlax-ename->vla-object ename))
  (setq elist (entget ename))
  (setq name (cdr (assoc 0 elist)))
)
;;面积的统计
(defun func-2 (/ p1 p2 p3 p4)
  (if (vlax-property-available-p obj "area")
    (setq SSarea (+ (vla-get-area obj) SSarea))
    (if        (= name "SOLID")
      (setq p1 (cdr (assoc 10 elist))
            p2 (cdr (assoc 11 elist))
            p3 (cdr (assoc 12 elist))
            p4 (cdr (assoc 13 elist))
            SSarea (+ (area-of-verties (list p1 p2 p4 p3)) SSarea)
      )
    )
  )
)
;;长度的统计
(defun func-3 (/ p1 p2 p3 p4)
  (cond
    ( (= name "MLINE")
      (setq totlen (+ totlen (ml-length ename)))
    )
    ( (or (= name "ARC")
          (= name "CIRCLE")
          (= name "LINE")
          (= name "POLYLINE")
          (= name "LWPOLYLINE")
          (= name "SPLINE")
          (= name "ELLIPSE")
      )
      (setq entlen (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename)))
      (setq totlen (+ totlen entlen))
    )
    ( (= name "SOLID")
      (setq p1 (cdr (assoc 10 elist)))
      (setq p2 (cdr (assoc 11 elist)))
      (setq p3 (cdr (assoc 12 elist)))
      (setq p4 (cdr (assoc 13 elist)))   
      (setq totlen (+ (length-of-verties (list p1 p2 p4 p3)) totlen))
    )
  )
)
;;Mline的长度
(defun ml-length (ename / j d ptlist)
  (foreach n (entget ename)
    (if        (= (car n) 11)
      (setq ptlist (cons (cdr n) ptlist))
    )
  )
  (setq        d 0 j -1)
  (repeat (1- (length ptlist))
    (setq j (1+ j))
    (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))  
  )
)
;;单位转化
(defun convert (x n /)
  (rtos (/ x (expt 10 n)) 2 n)
)
(defun convert1 (x n /)
  (rtos (/ x (expt 10 n)) 2 3)
)
;;n个点的长度
(defun length-of-verties (pts / i l len pts1)
  (setq i -1 len 0)
  (setq pts1 (cons (last pts) pts))
  (repeat (length pts)
    (setq i   (1+ i))
    (setq l   (distance (nth i pts1) (nth (1+ i) pts1)))
    (setq len (+ l len))
  )  
)
;;n个点的面积
(defun area-of-verties (pts / i area PX0 PY0 x1 y1 x2 y2)
  (setq i 0)
  (setq area 0)
  (setq px0 (caar pts))
  (setq py0 (cadar pts))
  (repeat (- (length pts) 1)
    (setq x1 (- (car  (nth i pts)) px0)
          y1 (- (cadr (nth i pts)) py0)
          x2 (- (car  (nth (1+ i) pts)) px0)
          y2 (- (cadr (nth (1+ i) pts)) py0)
    )          
    (setq area (+ (- (* x1 y2)(* x2 y1)) area))
    (setq i (1+ i))
  )
  (abs (/ area 2))
)
setq, totlen, 长度

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

zxq0220

已领礼包: 10666个

财富等级: 富甲天下
发表于 2008-1-2 20:21:53 | 显示全部楼层
[php]
;;;===================
;;;面积和长度统计程序
;;;highflybird kunming
;;;===================
(prompt "命令为:At")
(defun C:at (/ f ss l i SSarea totlen entlen
ename name obj text-S text-L insPt0 height
insPt1 insPt2 text-1 text-2 *APP *DOC *MSP
)
(vl-load-com)
(setq *APP (vlax-get-acad-object))
(setq *DOC (vla-get-activeDocument *APP))
(setq *MSP (vla-get-Modelspace *DOC))
(initget 1 "1 2 3")
(setq f (getkword "\n请输入你要统计的<1>面积<2>长度<3>两者:"))
(if (and
  (setq ss (ssget))
  (initget 1 "High")
  (setq insPt0 (getpoint "\n请输入文字插入点(文字高度H) : "))
  (if (= insPt0 "High") (princ
   (setq height (getdist "\n请输入文字高度:"))
   nil
  )
   T
  )
)
(progn
(setq l (sslength ss))
(setq i 0)
(setq SSarea 0)
(setq totlen 0)
(setq insPt1 (vlax-3d-point insPt0))
(setq insPt2 (polar insPt0 (* 1.5 Pi) (* 1.5 height)))
(setq insPt2 (vlax-3d-point insPt2))
(cond
  ((= f "1")
   (repeat l
    (func-1)
    (func-2)
    (setq i (1+ i))
   )
   (setq text-S (strcat (convert1 SSarea 6) "平方米"));总面积为:小数后6位
   (vla-addtext *MSP text-S insPt1 height)
  )
  ((= f "2")
   (repeat l
    (func-1)
    (func-3)
    (setq i (1+ i))
   )
   (setq text-L (strcat (convert1 totlen 3) "米")) ;总长度为:小数后3位
   (vla-addtext *MSP text-L insPt2 height)
  )
  ((= f "3")
   (repeat l
    (func-1)
    (func-2)
    (func-3)
    (setq i (1+ i))
   )
   (setq text-S (strcat (convert1 SSarea 6) "平方米"));总面积为:小数后6位
   (setq text-L (strcat (convert1 totlen 3) "米")) ;总长度为:小数后3位
   (vla-addtext *MSP text-S insPt1 height)
   (vla-addtext *MSP text-L insPt2 height)
  )
)
)
(alert "你没有选取物体或者输入正确的数据!")
)
(princ)
)
(defun func-1 ()
(setq ename (ssname ss i))
(setq obj (vlax-ename->vla-object ename))
(setq elist (entget ename))
(setq name (cdr (assoc 0 elist)))
)
;;面积的统计
(defun func-2 (/ p1 p2 p3 p4)
(if (vlax-property-available-p obj "area")
(setq SSarea (+ (vla-get-area obj) SSarea))
(if (= name "SOLID")
(setq p1 (cdr (assoc 10 elist))
p2 (cdr (assoc 11 elist))
p3 (cdr (assoc 12 elist))
p4 (cdr (assoc 13 elist))
SSarea (+ (area-of-verties (list p1 p2 p4 p3)) SSarea)
)
)
)
)
;;长度的统计
(defun func-3 (/ p1 p2 p3 p4)
(cond
( (= name "MLINE")
(setq totlen (+ totlen (ml-length ename)))
)
( (or (= name "ARC")
(= name "CIRCLE")
(= name "LINE")
(= name "POLYLINE")
(= name "LWPOLYLINE")
(= name "SPLINE")
(= name "ELLIPSE")
)
(setq entlen (vlax-curve-getdistatparam ename (vlax-curve-getendparam ename)))
(setq totlen (+ totlen entlen))
)
( (= name "SOLID")
(setq p1 (cdr (assoc 10 elist)))
(setq p2 (cdr (assoc 11 elist)))
(setq p3 (cdr (assoc 12 elist)))
(setq p4 (cdr (assoc 13 elist)))
(setq totlen (+ (length-of-verties (list p1 p2 p4 p3)) totlen))
)
)
)
;;Mline的长度
(defun ml-length (ename / j d ptlist)
(foreach n (entget ename)
(if (= (car n) 11)
(setq ptlist (cons (cdr n) ptlist))
)
)
(setq d 0 j -1)
(repeat (1- (length ptlist))
(setq j (1+ j))
(setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
)
)
;;单位转化
(defun convert (x n /)
(rtos (/ x (expt 10 n)) 2 n)
)
(defun convert1 (x n /)
(rtos (/ x (expt 10 n)) 2 3)
)
;;n个点的长度
(defun length-of-verties (pts / i l len pts1)
(setq i -1 len 0)
(setq pts1 (cons (last pts) pts))
(repeat (length pts)
(setq i (1+ i))
(setq l (distance (nth i pts1) (nth (1+ i) pts1)))
(setq len (+ l len))
)
)
;;n个点的面积
(defun area-of-verties (pts / i area PX0 PY0 x1 y1 x2 y2)
(setq i 0)
(setq area 0)
(setq px0 (caar pts))
(setq py0 (cadar pts))
(repeat (- (length pts) 1)
(setq x1 (- (car (nth i pts)) px0)
y1 (- (cadr (nth i pts)) py0)
x2 (- (car (nth (1+ i) pts)) px0)
y2 (- (cadr (nth (1+ i) pts)) py0)
)
(setq area (+ (- (* x1 y2)(* x2 y1)) area))
(setq i (1+ i))
)
(abs (/ area 2))
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

sandyhuahua
 楼主| 发表于 2008-1-3 14:55:33 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
二楼修改后选择物体显示“你没有选择物体或者输入正确的数据”，不知是什么原因，不过还是谢谢您的支持。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

carrot1983
发表于 2008-1-3 18:36:55 | 显示全部楼层
[php]
;;;===================
;;;面积和长度统计程序
;;;highflybird kunming
;;;===================
(prompt "命令为:At")
(defun C:at (/             f             ss             l             i             SSarea  totlen
             entlen  ename   name    obj     text-S  text-L  insPt0
             height  insPt1  insPt2  text-1  text-2  *APP    *DOC
             *MSP
            )
  (vl-load-com)
  (setq user1 (getvar "userr1"))
  (setq *APP (vlax-get-acad-object))
  (setq *DOC (vla-get-activeDocument *APP))
  (setq *MSP (vla-get-Modelspace *DOC))
  (initget 1 "1 2 3")
  (setq f (getkword "\n请输入你要统计的<1>面积<2>长度<3>两者:"))
  (if
    (and
      (setq ss (ssget))
      (setq insPt0 (getpoint "\n请输入文字插入点: "))
    )
     (progn
       (setq height
              (getdist (strcat "\n请输入文字高度<" (rtos user1 2) ">:")
              )
       )
       (if (= height nil)
         (setq height user1)
       )
       (setvar "userr1" height)
       (setq l (sslength ss))
       (setq i 0)
       (setq SSarea 0)
       (setq totlen 0)
       (setq insPt1 (vlax-3d-point insPt0))
       (setq insPt2 (polar insPt0 (* 1.5 Pi) (* 1.5 height)))
       (setq insPt2 (vlax-3d-point insPt2))
       (cond
         ((= f "1")
          (repeat l
            (func-1)
            (func-2)
            (setq i (1+ i))
          )
          (setq text-S (strcat (convert1 SSarea 6) "平方米"))
                                        ;总面积为:小数后6位
          (vla-addtext *MSP text-S insPt1 height)
         )
         ((= f "2")
          (repeat l
            (func-1)
            (func-3)
            (setq i (1+ i))
          )
          (setq text-L (strcat (convert1 totlen 3) "米"))
                                        ;总长度为:小数后3位
          (vla-addtext *MSP text-L insPt2 height)
         )
         ((= f "3")
          (repeat l
            (func-1)
            (func-2)
            (func-3)
            (setq i (1+ i))
          )
          (setq text-S (strcat (convert1 SSarea 6) "平方米"))
                                        ;总面积为:小数后6位
          (setq text-L (strcat (convert1 totlen 3) "米"))
                                        ;总长度为:小数后3位
          (vla-addtext *MSP text-S insPt1 height)
          (vla-addtext *MSP text-L insPt2 height)
         )
       )
     )
     (alert "你没有选取物体或者输入正确的数据!")
  )
  (princ)
)
(defun func-1 ()
  (setq ename (ssname ss i))
  (setq obj (vlax-ename->vla-object ename))
  (setq elist (entget ename))
  (setq name (cdr (assoc 0 elist)))
)
;;面积的统计
(defun func-2 (/ p1 p2 p3 p4)
  (if (vlax-property-available-p obj "area")
    (setq SSarea (+ (vla-get-area obj) SSarea))
    (if        (= name "SOLID")
      (setq p1           (cdr (assoc 10 elist))
            p2           (cdr (assoc 11 elist))
            p3           (cdr (assoc 12 elist))
            p4           (cdr (assoc 13 elist))
            SSarea (+ (area-of-verties (list p1 p2 p4 p3)) SSarea)
      )
    )
  )
)
;;长度的统计
(defun func-3 (/ p1 p2 p3 p4)
  (cond
    ((= name "MLINE")
     (setq totlen (+ totlen (ml-length ename)))
    )
    ((or (= name "ARC")
         (= name "CIRCLE")
         (= name "LINE")
         (= name "POLYLINE")
         (= name "LWPOLYLINE")
         (= name "SPLINE")
         (= name "ELLIPSE")
     )
     (setq entlen (vlax-curve-getdistatparam
                    ename
                    (vlax-curve-getendparam ename)
                  )
     )
     (setq totlen (+ totlen entlen))
    )
    ((= name "SOLID")
     (setq p1 (cdr (assoc 10 elist)))
     (setq p2 (cdr (assoc 11 elist)))
     (setq p3 (cdr (assoc 12 elist)))
     (setq p4 (cdr (assoc 13 elist)))
     (setq totlen (+ (length-of-verties (list p1 p2 p4 p3)) totlen))
    )
  )
)
;;Mline的长度
(defun ml-length (ename / j d ptlist)
  (foreach n (entget ename)
    (if        (= (car n) 11)
      (setq ptlist (cons (cdr n) ptlist))
    )
  )
  (setq        d 0
        j -1
  )
  (repeat (1- (length ptlist))
    (setq j (1+ j))
    (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
  )
)
;;单位转化
(defun convert (x n /)
  (rtos (/ x (expt 10 n)) 2 n)
)
(defun convert1        (x n /)
  (rtos (/ x (expt 10 n)) 2 3)
)
;;n个点的长度
(defun length-of-verties (pts / i l len pts1)
  (setq        i -1
        len 0
  )
  (setq pts1 (cons (last pts) pts))
  (repeat (length pts)
    (setq i (1+ i))
    (setq l (distance (nth i pts1) (nth (1+ i) pts1)))
    (setq len (+ l len))
  )
)
;;n个点的面积
(defun area-of-verties (pts / i area PX0 PY0 x1 y1 x2 y2)
  (setq i 0)
  (setq area 0)
  (setq px0 (caar pts))
  (setq py0 (cadar pts))
  (repeat (- (length pts) 1)
    (setq x1 (- (car (nth i pts)) px0)
          y1 (- (cadr (nth i pts)) py0)
          x2 (- (car (nth (1+ i) pts)) px0)
          y2 (- (cadr (nth (1+ i) pts)) py0)
    )
    (setq area (+ (- (* x1 y2) (* x2 y1)) area))
    (setq i (1+ i))
  )
  (abs (/ area 2))
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

sandyhuahua
 楼主| 发表于 2008-1-7 16:26:30 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
四楼的优化非常好，非常感谢，但我还有一个问题，我通常只需标注面积，第一个选择项我希望默认为选择1（最好默认值可以修改），最理想的状态是能有一个选项板，需设置时键入O,设置好字高、标注内容等，实际使用时，可直接标注面积或长度或二者全标，不用每次都要输入选择项，选择文字高度等。另外标注的精度能修改吗？我通常只需小数点后的一位或两位，不知修改哪个参数可以实现。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

sandyhuahua
 楼主| 发表于 2008-1-10 12:25:54 | 显示全部楼层
顶
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

carrot1983
发表于 2008-1-10 14:19:39 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
最后一次改啦。。。再有什么要求，只能叫highflybird 重新给你写一个。。。


  4. ;;;===================
  5. ;;;面积和长度统计程序
  6. ;;;highflybird kunming
  7. ;;;===================
  8. (vl-load-com)
  9. (prompt "命令为:At")
  10. (defun C:at (/             *APP    *DOC    *MSP    F             HEIGHT  I
  11.              INSPT0  INSPT1  INSPT2  L             SS             SSAREA  TEXT-L
  12.              TEXT-S  TOTLEN
  13.             )
  14.   (setq *APP (vlax-get-acad-object))
  15.   (setq *DOC (vla-get-activeDocument *APP))
  16.   (setq *MSP (vla-get-Modelspace *DOC))
  17.   (if 文字高度
  18.     (princ (strcat "\n文字高度为 " (rtos 文字高度 2)))
  19.     (princ "\n文字高度为 300 ")
  20.   )
  21.   (if (not (vlax-ldata-get "dict" "getkword"))
  22.     (vlax-ldata-put "dict" "getkword" "1")
  23.   )
  24.   (initget "1 2 3 4")
  25.   (setq        f
  26.          (getkword
  27.            (strcat
  28.              "\n请输入你要统计的[1]面积[2]长度[3]两者/[4]改高度并统计面积 <"
  29.              (vlax-ldata-get
  30.                "dict"
  31.                "getkword"
  32.              )
  33.              ">: "
  34.            )
  35.          )
  36.   )
  37.   (if (= f nil)
  38.     (setq f (vlax-ldata-get "dict" "getkword"))
  39.   )
  40.   (vlax-ldata-put "dict" "getkword" f)
  41.   (if
  42.     (and
  43.       (setq ss (ssget))
  44.       (setq insPt0 (getpoint "\n请输入文字插入点: "))
  45.     )
  46.      (progn
  47.        (if (= height nil)
  48.          (setq height 文字高度)
  49.        )
  50.        (if (= f "4")
  51.          (progn
  52.            (setq height
  53.                   (getdist insPt0 "\n请输入文字高度<300>:")
  54.            )
  55.            (if (= height nil)
  56.              (setq height 300)
  57.            )
  58.            (setq 文字高度 height)
  59.          )
  60.        )
  61.        (setq l (sslength ss))
  62.        (setq i 0)
  63.        (setq SSarea 0)
  64.        (setq totlen 0)
  65.        (setq insPt1 (vlax-3d-point insPt0))
  66.        (setq insPt2 (polar insPt0 (* 1.5 Pi) (* 1.5 height)))
  67.        (setq insPt2 (vlax-3d-point insPt2))
  68.        (cond
  69.          ((or (= f "1") (= f "4"))
  70.           (repeat l
  71.             (func-1)
  72.             (func-2)
  73.             (setq i (1+ i))
  74.           )
  75.           (setq text-S (strcat (convert1 SSarea 6) "平方米"))
  76.                                         ;总面积为:小数后6位
  77.           (vla-addtext *MSP text-S insPt1 height)
  78.          )
  79.          ((= f "2")
  80.           (repeat l
  81.             (func-1)
  82.             (func-3)
  83.             (setq i (1+ i))
  84.           )
  85.           (setq text-L (strcat (convert1 totlen 3) "米"))
  86.                                         ;总长度为:小数后3位
  87.           (vla-addtext *MSP text-L insPt2 height)
  88.          )
  89.          ((= f "3")
  90.           (repeat l
  91.             (func-1)
  92.             (func-2)
  93.             (func-3)
  94.             (setq i (1+ i))
  95.           )
  96.           (setq text-S (strcat (convert1 SSarea 6) "平方米"))
  97.                                         ;总面积为:小数后6位
  98.           (setq text-L (strcat (convert1 totlen 3) "米"))
  99.                                         ;总长度为:小数后3位
  100.           (vla-addtext *MSP text-S insPt1 height)
  101.           (vla-addtext *MSP text-L insPt2 height)
  102.          )
  103.        )
  104.      )
  105.      (alert "你没有选取物体或者输入正确的数据!")
  106.   )
  107.   (princ)
  108. )
  109. (defun func-1 ()
  110.   (setq ename (ssname ss i))
  111.   (setq obj (vlax-ename->vla-object ename))
  112.   (setq elist (entget ename))
  113.   (setq name (cdr (assoc 0 elist)))
  114. )
  115. ;;面积的统计
  116. (defun func-2 (/ p1 p2 p3 p4)
  117.   (if (vlax-property-available-p obj "area")
  118.     (setq SSarea (+ (vla-get-area obj) SSarea))
  119.     (if        (= name "SOLID")
  120.       (setq p1           (cdr (assoc 10 elist))
  121.             p2           (cdr (assoc 11 elist))
  122.             p3           (cdr (assoc 12 elist))
  123.             p4           (cdr (assoc 13 elist))
  124.             SSarea (+ (area-of-verties (list p1 p2 p4 p3)) SSarea)
  125.       )
  126.     )
  127.   )
  128. )
  129. ;;长度的统计
  130. (defun func-3 (/ p1 p2 p3 p4)
  131.   (cond
  132.     ((= name "MLINE")
  133.      (setq totlen (+ totlen (ml-length ename)))
  134.     )
  135.     ((or (= name "ARC")
  136.          (= name "CIRCLE")
  137.          (= name "LINE")
  138.          (= name "POLYLINE")
  139.          (= name "LWPOLYLINE")
  140.          (= name "SPLINE")
  141.          (= name "ELLIPSE")
  142.      )
  143.      (setq entlen (vlax-curve-getdistatparam
  144.                     ename
  145.                     (vlax-curve-getendparam ename)
  146.                   )
  147.      )
  148.      (setq totlen (+ totlen entlen))
  149.     )
  150.     ((= name "SOLID")
  151.      (setq p1 (cdr (assoc 10 elist)))
  152.      (setq p2 (cdr (assoc 11 elist)))
  153.      (setq p3 (cdr (assoc 12 elist)))
  154.      (setq p4 (cdr (assoc 13 elist)))
  155.      (setq totlen (+ (length-of-verties (list p1 p2 p4 p3)) totlen))
  156.     )
  157.   )
  158. )
  159. ;;Mline的长度
  160. (defun ml-length (ename / j d ptlist)
  161.   (foreach n (entget ename)
  162.     (if        (= (car n) 11)
  163.       (setq ptlist (cons (cdr n) ptlist))
  164.     )
  165.   )
  166.   (setq        d 0
  167.         j -1
  168.   )
  169.   (repeat (1- (length ptlist))
  170.     (setq j (1+ j))
  171.     (setq d (+ d (distance (nth j ptlist) (nth (1+ j) ptlist))))
  172.   )
  173. )
  174. ;;单位转化
  175. (defun convert (x n /)
  176.   (rtos (/ x (expt 10 n)) 2 n)
  177. )
  178. (defun convert1        (x n /)
  179.   (rtos (/ x (expt 10 n)) 2 3)
  180. )
  181. ;;n个点的长度
  182. (defun length-of-verties (pts / i l len pts1)
  183.   (setq        i -1
  184.         len 0
  185.   )
  186.   (setq pts1 (cons (last pts) pts))
  187.   (repeat (length pts)
  188.     (setq i (1+ i))
  189.     (setq l (distance (nth i pts1) (nth (1+ i) pts1)))
  190.     (setq len (+ l len))
  191.   )
  192. )
  193. ;;n个点的面积
  194. (defun area-of-verties (pts / i area PX0 PY0 x1 y1 x2 y2)
  195.   (setq i 0)
  196.   (setq area 0)
  197.   (setq px0 (caar pts))
  198.   (setq py0 (cadar pts))
  199.   (repeat (- (length pts) 1)
  200.     (setq x1 (- (car (nth i pts)) px0)
  201.           y1 (- (cadr (nth i pts)) py0)
  202.           x2 (- (car (nth (1+ i) pts)) px0)
  203.           y2 (- (cadr (nth (1+ i) pts)) py0)
  204.     )
  205.     (setq area (+ (- (* x1 y2) (* x2 y1)) area))
  206.     (setq i (1+ i))
  207.   )
  208.   (abs (/ area 2))
  209. )

点评

flytodayddc
错误: 参数类型错误: numberp: nil，，加载后才先输入4后再输1不出错，望卜哥修正，谢谢。好不容易找到的哈  发表于 2013-6-9 00:30
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

sandyhuahua
 楼主| 发表于 2008-1-22 22:21:04 | 显示全部楼层
谢谢楼上，正是我想要的，方便了很多，真是太感谢了！！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-2-19 06:31 , Processed in 0.437373 second(s), 50 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表