[LISP函数]：线长统计及总长统计

y562288 · 发表于 2008-12-22 11:07:29

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

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

×

我想咨询您一个问题，我们这边搞坝身坝基处理，有很多直线，有没有一个程序一次性把单根直线的长度和总长度都统计出来的

Underway · 发表于 2008-12-22 11:45:36

参考先
http://www.autocad.com.tw/asp/Sh ... utoCAD&ID=19078

y562288 · 发表于 2008-12-22 16:39:06

我的要求是要把每根线的长度全部量测出来，最后可以直接导入EXCEL里边的那种，不知道可以实现，上面发的程序我看一下，好像不行呢，

秋枫 · 发表于 2008-12-22 17:13:18

(defun c:TEST (/ ssmap getarea getlen alist lenlist)
(defun getarea (e)
(if (vlax-property-available-p (vlax-ename->vla-object e) "area")
(vla-get-area (vlax-ename->vla-object e))
0
)
)
(defun getlen (e)
(if (vlax-property-available-p (vlax-ename->vla-object e) "length")
(vla-get-length (vlax-ename->vla-object e))
0
)
)
(defun SSMAP (func ss / n)
(if (eq 'PICKSET (type ss))
(repeat (setq n (fix (sslength ss))) ; fixed
(apply func (list (ssname ss (setq n (1- n)))))
)
)
)
;; main
(ssmap '(lambda (e)
(setq alist (cons (getarea e) alist))
(setq lenlist (cons (getlen e) lenlist))
)
(ssget
'((0 . "CIRCLE,POLYLINE,LWPOLYLINE,ARC,SPLINE,REGION,ELLIPSE,LINE")
)
)
)
(princ "\n总面积：")
(princ (apply '+ alist))
(princ "\n总长度：")
(princ (apply '+ lenlist))
(princ)
)
(princ "\n长度统计求和程序秋枫，二〇〇八年十二月二十二日")
(princ)

(defun c:TEST (/ ssmap getarea getlen alist lenlist) 
  (defun getarea (e) 
    (if        (vlax-property-available-p (vlax-ename->vla-object e) "area") 
      (vla-get-area (vlax-ename->vla-object e)) 
      0 
    ) 
  ) 
  (defun getlen        (e) 
    (if        (vlax-property-available-p (vlax-ename->vla-object e) "length") 
      (vla-get-length (vlax-ename->vla-object e)) 
      0 
    ) 
  ) 
  (defun SSMAP (func ss / n) 
    (if        (eq 'PICKSET (type ss)) 
      (repeat (setq n (fix (sslength ss))) ; fixed 
        (apply func (list (ssname ss (setq n (1- n))))) 
      ) 
    ) 
  ) 
  ;; main 
  (ssmap '(lambda (e) 
            (setq alist (cons (getarea e) alist)) 
            (setq lenlist (cons (getlen e) lenlist)) 
          ) 
         (ssget 
           '((0 . "CIRCLE,POLYLINE,LWPOLYLINE,ARC,SPLINE,REGION,ELLIPSE,LINE") 
            ) 
         ) 
  ) 
  (princ "\n总面积：") 
  (princ (apply '+ alist)) 
  (princ "\n总长度：") 
  (princ (apply '+ lenlist)) 
  (princ) 
) 
 
(princ "\n长度统计求和程序  秋枫，二〇〇八年十二月二十二日") 
(princ)

y562288 · 发表于 2008-12-22 17:19:04

选择对象: ; 错误: no function definition: VLAX-ENAME->VLA-OBJECT
不晓得什么原因

Underway · 发表于 2008-12-22 17:42:05

先跑这个:
command: (vl-load-com)

zj-οО○oοО · 发表于 2008-12-24 00:49:38

[PHP](DEFUN c:tt (/ ss loop num len)
(SETVAR "CMDECHO" 0)
(PROMPT "\n选择需要计算长度的直线或多段线：")
(SETQ ss  (SSGET '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))
loop (IF (NULL ss)
   0
   (SSLENGTH ss)
   )
num  -1
len  0
)
(REPEAT loop
  (COMMAND "._LENGTHEN" (SSNAME ss (SETQ num (1+ num))) "")
  (SETQ len (+ len (GETVAR "PERIMETER")))
)
(PRINC (STRCAT "\n" (ITOA loop) "个对象总长 = " (RTOS len 2 5)))
(PRINC)
)[/PHP]
可测LINE,POLYLINE,3DPOLYLINE,SPLINE,ELLIPSE,CIRCLE,ARC
方法简单些，但通用性强些

carrot1983 · 发表于 2008-12-24 08:52:16

Other method

;;;练习1: 曲线的长度及面积的总和
;;;writenn by carrot1983 2008-12-24 REV
;;;测试环境: CAD2006
(defun C:TT1 (/ E I LEN LENLIST SS AREA AREALIST SSLEN)
(princ "\n练习: 曲线的长度及曲线的总和")
(setq SS (ssget
'((0 . "SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE"))
)
)
(setq SSLEN (sslength SS))
(repeat (setq I SSLEN)
(setq E (ssname SS (setq I (1- I))))
(setq LENLIST (cons (vlax-curve-getdistatparam
E
(vlax-curve-getendparam E)
)
LENLIST
)
)
(setq AREALIST (cons (vlax-curve-getarea E)
AREALIST
)
)
)
(setq LEN (apply '+ LENLIST))
(setq AREA (apply '+ AREALIST))
(princ
(strcat "\n"
"总长 = "
(rtos LEN 2 5)
" 总面积 = "
(rtos AREA 2 5)
)
)
(princ)
)

;;;练习1: 曲线的长度及面积的总和 
;;;writenn by carrot1983 2008-12-24 REV 
;;;测试环境: CAD2006 
(defun C:TT1 (/ E I LEN LENLIST SS AREA AREALIST SSLEN) 
  (princ "\n练习: 曲线的长度及曲线的总和") 
  (setq        SS (ssget 
             '((0 . "SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE")) 
           ) 
  ) 
  (setq SSLEN (sslength SS)) 
  (repeat (setq I SSLEN) 
    (setq E (ssname SS (setq I (1- I)))) 
    (setq LENLIST (cons        (vlax-curve-getdistatparam 
                          E 
                          (vlax-curve-getendparam E) 
                        ) 
                        LENLIST 
                  ) 
    ) 
    (setq AREALIST (cons (vlax-curve-getarea E) 
                         AREALIST 
                   ) 
    ) 
  ) 
  (setq LEN (apply '+ LENLIST)) 
  (setq AREA (apply '+ AREALIST)) 
  (princ 
    (strcat "\n" 
            "总长 = " 
            (rtos LEN 2 5) 
            " 总面积 = " 
            (rtos AREA 2 5) 
    ) 
  ) 
  (princ) 
)

taner · 发表于 2008-12-24 09:13:44

最初由秋枫发布
[B][code](defun c:TEST (/ ssmap getarea getlen alist lenlist)
(defun getarea (e)
(if (vlax-property-available-p (vlax-ename->vla-object e) "area")
(vla-get-area (vlax-ename->vla-object e))... [/B]

对region，长度返回0。用个原始的：

(defun getlen (sname / l)
  (command "._area" "_o" sname)
  (setq l (getvar "perimeter"))
)
(defun getarea (sname / ar)
  (command "._area" "_o" sname)
  (setq ar (getvar "area"))
)

eachy · 发表于 2008-12-24 09:48:52

用 vlax-curve-getarea 和 vlax-curve-getdistatparam

taner · 发表于 2008-12-24 10:03:51

最初由 eachy 发布
[B]用 vlax-curve-getarea 和 vlax-curve-getdistatparam [/B]

vlax-curve-getdistatparam 对REGION应该也是无效的。

y562288 · 发表于 2008-12-24 10:10:24

非常感谢各位的支持与捧场，特别感谢7楼的朋友，感觉可以了，谢谢

carrot1983 · 发表于 2008-12-24 10:34:39

(defun getlen (sname / l)
(command "._area" "_o" sname)
(setq l (getvar "perimeter"))
)
(defun getarea (sname / ar)
(command "._area" "_o" sname)
(setq ar (getvar "area"))
)

最早学习的时候就用这个。。。
绕了那么大的圈，还是回到了原来的地方
呵呵。。。发现自已没长进啊。。。

[FONT=courier new]
;;;= = = = = = = Begin = = = = = = =
;;;练习1: 曲线的长度总和
;;;writenn by carrot1983 2008-12-24
;;;测试环境: CAD2006
(defun C:TT1 (/ E I LEN LENLIST SS SSLEN)
(princ "\n练习: 曲线的长度总和")
(setq SS
(ssget
'((0
.
"LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE"
)
)
)
)
(setq SSLEN (sslength SS))
(repeat (setq I SSLEN)
(setq E (ssname SS (setq I (1- I))))
(setq LENLIST (cons (vlax-curve-getdistatparam
E
(vlax-curve-getendparam E)
)
LENLIST
)
)
)
(setq LEN (apply '+ LENLIST))
(princ
(strcat "\n"
"总长 = "
(rtos LEN 2 5)
)
)
(princ)
)
;;;TT1的缺点：没办法求出HATCH,REGION的长度
;;;= = = = = = = I am separator = = = = = = =
;;;练习2: 曲线的面积总和
;;;writenn by carrot1983 2008-12-24
;;;测试环境: CAD2006
(defun C:TT2 (/ AREA AREALIST E I SS SSLEN)
(princ "\n练习: 曲线的面积总和")
(setq SS
(ssget
'((0
.
"SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE"
)
)
)
)
(setq SSLEN (sslength SS))
(repeat (setq I SSLEN)
(setq E (ssname SS (setq I (1- I))))
(setq AREALIST (cons (vlax-curve-getarea E)
AREALIST
)
)
)
(setq AREA (apply '+ AREALIST))
(princ
(strcat "\n"
" 总面积 = "
(rtos AREA 2 5)
)
)
(princ)
)
;;;TT2的缺点：没办法求出HATCH,REGION的面积
;;;为什么面积跟长度分开，就是因为LINE是没有面积属性。
;;;当然可以在循环里面加个判断。
;;;= = = = = = = I am separator = = = = = = =
;;;这次写个完整版的
;;;这个command的版本较简单，又能适用于填充和面域。
;;;练习3: 长度及面积的总和
;;;writenn by carrot1983 2008-12-24
;;;测试环境: CAD2006
(defun C:TT3 (/ AREA AREALIST E I LEN LENLIST SS SSLEN V0)
(setvar "cmdecho" 0)
(princ "\n统计长度及面积的总和 carrot1983 2008-12-24")
(setq
SS
(ssget
'((0
.
"LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,HATCH,REGION"
)
)
)
)
(setq SSLEN (sslength SS))
(repeat (setq I SSLEN)
(setq E (ssname SS (setq I (1- I))))
(setq V0 (cdr (assoc 0 (entget E))))
(cond ((= V0 "LINE")
(command "._LENGTHEN" E "")
(setq LENLIST (cons (getvar "PERIMETER") LENLIST))
)
((/= V0 "LINE")
(command "._AREA" "O" E)
(setq LENLIST (cons (getvar "PERIMETER") LENLIST))
(setq AREALIST (cons (getvar "AREA") AREALIST))
)
)
)
(setq LEN (apply '+ LENLIST))
(setq AREA (apply '+ AREALIST))
(princ
(strcat "\n"
"总长 = "
(rtos LEN 2 5)
" 总面积 = "
(rtos AREA 2 5)
)
)
(setvar "cmdecho" 1)
(princ)
)
;;;= = = = = = = End = = = = = = =
[/FONT]

[FONT=courier new] 
;;;= = = = = = = Begin = = = = = = = 
;;;练习1: 曲线的长度总和 
;;;writenn by carrot1983 2008-12-24 
;;;测试环境: CAD2006 
(defun C:TT1 (/ E I LEN LENLIST SS SSLEN) 
  (princ "\n练习: 曲线的长度总和") 
  (setq        SS 
         (ssget 
           '((0 
              . 
              "LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE" 
             ) 
            ) 
         ) 
  ) 
  (setq SSLEN (sslength SS)) 
  (repeat (setq I SSLEN) 
    (setq E (ssname SS (setq I (1- I)))) 
    (setq LENLIST (cons        (vlax-curve-getdistatparam 
                          E 
                          (vlax-curve-getendparam E) 
                        ) 
                        LENLIST 
                  ) 
    ) 
  ) 
  (setq LEN (apply '+ LENLIST)) 
  (princ 
    (strcat "\n" 
            "总长 = " 
            (rtos LEN 2 5) 
    ) 
  ) 
  (princ) 
) 
;;;TT1的缺点：没办法求出HATCH,REGION的长度 
 
 
;;;= = = = = = = I am separator = = = = = = = 
;;;练习2: 曲线的面积总和 
;;;writenn by carrot1983 2008-12-24 
;;;测试环境: CAD2006 
(defun C:TT2 (/ AREA AREALIST E I SS SSLEN) 
  (princ "\n练习: 曲线的面积总和") 
  (setq        SS 
         (ssget 
           '((0 
              . 
              "SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE" 
             ) 
            ) 
         ) 
  ) 
  (setq SSLEN (sslength SS)) 
  (repeat (setq I SSLEN) 
    (setq E (ssname SS (setq I (1- I)))) 
    (setq AREALIST (cons (vlax-curve-getarea E) 
                         AREALIST 
                   ) 
    ) 
  ) 
  (setq AREA (apply '+ AREALIST)) 
  (princ 
    (strcat "\n" 
            " 总面积 = " 
            (rtos AREA 2 5) 
    ) 
  ) 
  (princ) 
) 
;;;TT2的缺点：没办法求出HATCH,REGION的面积 
;;;为什么面积跟长度分开，就是因为LINE是没有面积属性。 
;;;当然可以在循环里面加个判断。 
 
 
;;;= = = = = = = I am separator = = = = = = = 
;;;这次写个完整版的 
;;;这个command的版本较简单，又能适用于填充和面域。 
;;;练习3: 长度及面积的总和 
;;;writenn by carrot1983 2008-12-24 
;;;测试环境: CAD2006 
(defun C:TT3 (/ AREA AREALIST E I LEN LENLIST SS SSLEN V0) 
  (setvar "cmdecho" 0) 
  (princ "\n统计长度及面积的总和 carrot1983 2008-12-24") 
  (setq 
    SS 
     (ssget 
       '((0 
          . 
          "LINE,SPLINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,HATCH,REGION" 
         ) 
        ) 
     ) 
  ) 
  (setq SSLEN (sslength SS)) 
  (repeat (setq I SSLEN) 
    (setq E (ssname SS (setq I (1- I)))) 
    (setq V0 (cdr (assoc 0 (entget E)))) 
    (cond ((= V0 "LINE") 
           (command "._LENGTHEN" E "") 
           (setq LENLIST (cons (getvar "PERIMETER") LENLIST)) 
          ) 
          ((/= V0 "LINE") 
           (command "._AREA" "O" E) 
           (setq LENLIST (cons (getvar "PERIMETER") LENLIST)) 
           (setq AREALIST (cons (getvar "AREA") AREALIST)) 
          ) 
    ) 
  ) 
  (setq LEN (apply '+ LENLIST)) 
  (setq AREA (apply '+ AREALIST)) 
  (princ 
    (strcat "\n" 
            "总长 = " 
            (rtos LEN 2 5) 
            " 总面积 = " 
            (rtos AREA 2 5) 
    ) 
  ) 
  (setvar "cmdecho" 1) 
  (princ) 
) 
;;;= = = = = = = End = = = = = = = 
  [/FONT]

xiangandqing · 发表于 2008-12-24 16:16:14

暂时还不懂,学习中

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

[LISP函数]：线长统计及总长统计

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

相关帖子