悬赏高手写个统计周长面积输出excel。

jerisonfang

厉害哦

转风小怪

大佬厉害了,虽然看不懂.

li_fang_2008

(defun c:batchMeasure ()
  (setq file (getfiled "选择保存Excel文件的路径：" ""))
  (setq cnt 1)
  (setq entlist (entsel "\n选择要测量的图形（多选）："))
  
  (vl-load-com)
  (foreach ent entlist
    (setq obj (vlax-ename->vla-object (car ent)))
   
    ; 检查是否为封闭图形
    (if (and (= (vla-get-objectname obj) "AcDbCurve") (not (vla-getisclosed obj)))
      (progn
        (alert (strcat "\n图形 " (itoa cnt) " 不是封闭图形，已跳过测量。"))
        (setq cnt (1+ cnt))
      )
      ; 计算周长
      (progn
        (setq perimeter (vla-get-Perimeter obj))
        
        ;绘制文本标记
        (vla-addtext obj (strcat "P:" (rtos perimeter 2 2)) (vla-get-startpoint obj))
        
        ; 计算面积
        (setq area (vla-get-Area obj))
        
        ;绘制文本标记
        (vla-addtext obj (strcat "A:" (rtos area 2 2)) (vla-get-endpoint obj))
        
        ; 将周长面积输出到Excel
        (vlax-invoke
          (vlax-get-property (vlax-create-object "Excel.Application")
          "Workbooks")
          "Open" file
        )
        (vlax-invoke
          (vlax-get-property
            (vlax-get-property
              (vlax-get-property (vlax-get-property
                (vlax-get-property (vlax-get-property (vlax-get-object excel "Workbooks") "Item" 1) "Worksheets") "Item" 1) "Range" "A1")
              "Offset" (+ (1- cnt) 1) 0)
            "Value")
          "Set" (vlax-invoke (vlax-create-object "VARIANT") "Array" (list cnt perimeter area))
        )
        (vlax-invoke (vlax-get-property (vlax-get-object excel "ActiveWorkbook") "Save"))
        (vlax-invoke (vlax-get-property (vlax-get-object excel "ActiveWorkbook") "Close"))
        (setq cnt (1+ cnt))
      )
    )
  )
  (vlax-release-object excel)
  (princ)
)

lailaifa

langjs 发表于 2012-7-3 09:49
既然发消息给我那就编一个。使用时不保证100％正确。
;;; 框选封闭区域面积到excel    by:langjs
;;; ＝ ...

能改成输出外形长宽尺寸到EXCEL

zhangrunze

hao3ren 发表于 2012-7-4 00:01
;;; 框选封闭区域面积到excel    by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:qq (/ d ...

辛苦了~感谢分享，最后个括号多了。
加入是否输出Excel选项就完美了？