框选封闭区域面积到excel

香田里浪人

;;; 框选封闭区域面积到excel   
(defun c:jsmjdc(/ ACADDOC ACADSPC OBJAREA OBJLLPOINT OBJRUPOINT SELECTIONSET TEXTBASEPOINT TEXTHEIGHT TEXTINDEX TEXTOBJ)
   (vl-load-com)
   (setq AcadDoc (vla-get-activedocument (vlax-get-acad-object)))
   (if (= (getvar "TILEMODE") 1)(setq AcadSpc (vla-get-modelspace AcadDoc))(setq AcadSpc (vla-get-paperspace AcadDoc)))
   (setq TextHeight (getdist "\n输入标注文字高度:")
Textbh (getstring "\n输入编号前缀:")
TextIndex (getint "\n输入起始编号:")
)
    (setq f (getfiled "指定输出文件路径" "" "xls" 1) f (open f "a"));;;指定输出文件路径
  (write-line "编号\t面积(㎡)" f)
     (ssget '((0 . "CIRCLE,LWPOLYLINE,ELLIPSE")))
(command "layer" "M" "计算面积" "C" "4" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
(command "style" "tukou" "黑体" "0" "" "0" "" "")
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
(defun maketext (txt pt)  ; 生成文字子函数
    (entmake (list '(0 . "TEXT") (cons 10 pt) (cons 40 TextHeight) (cons 1 txt) '(41 . 0.8)'(7 . "BG_ST")))
  )
   (setq Selectionset (vla-get-activeselectionset AcadDoc))
   (if (and TextHeight Selectionset TextIndex)
     (vlax-for Obj Selectionset
       (setq ObjArea (vla-get-area obj)
      ObjLlPoint nil
      ObjRuPoint nil
      )
       (vla-GetBoundingBox Obj 'ObjLlPoint 'ObjRuPoint)
       (setq TextBasePoint (mapcar '(lambda(x y) (/ (+ x y) 2)) (vlax-safearray->list ObjLlPoint)(vlax-safearray->list ObjRuPoint))
      TextObj (vla-addtext AcadSpc (strcat Textbh (itoa TextIndex) "=" (rtos (/ ObjArea 1)2 2) "㎡") (vlax-3d-point TextBasePoint) TextHeight)
      )
(write-line (strcat (strcat Textbh (itoa TextIndex)) "\t" (rtos (/ ObjArea 1)2 2) ) f)
       (vla-put-alignment TextObj acAlignmentCenter)
       (vla-put-TextAlignmentPoint TextObj (vlax-3d-point TextBasePoint))   
    (setq TextIndex (1+ TextIndex))      
       )     
)
(close f)
   )

跑了一下午

香田里浪人 发表于 2014-4-30 11:11
将 (rtos (/ ObjArea 1)2 2) 改为 (rtos (/ ObjArea 1000000)2 2) 即可。如果小数点后要保留3位，将2 2改 ...

谢谢楼主，统计面积到表格的时候真的简单很多了

MXS

想请教一下如果我想获取一个未封闭图形的面积咋办，可能只有一个接触点未封闭

jierc

谢谢楼主，但框选时顺序不对，都是从右至左

kwok

看到源码就要支持，谢谢分享.

flytoday

增加个统计汇总标注于图中。效果会更好。。

donghuidong2003

支持源码，好

llsheng_73

为什么我不能给楼主评分，权限不够？

ymcui

看到源码就要支持，谢谢分享

ymcui

好程序更要支持.

springwillow

好，我也整个示意的!

1. http://ishare.iask.sina.com.cn/f/68448880.html

复制代码

flytoday

楼上这个不如楼主的好用。。。。
而已对话框出错。。。
对于未封闭的图形无效。。。
2006版本不能用‘’‘’。。。





命令: SCBH
** DCL could not be found **
选择对象: 指定对角点: 找到 3 个
选择对象:
; 错误: 参数类型错误: fixnump: nil


还有对圆。。未封闭的弧形无效。。。。

注册

请问，如果制图是以毫米为单位的，比如1米在cad中输入的是1000，请问修改哪一句可以使得出的面积结果是真实的面积，而不是以毫米得出的结果，比如1米*1米应该得出1平方米，而非1000*1000平方米，谢谢