厉害哦
大佬厉害了,虽然看不懂.
(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)
)
langjs 发表于 2012-7-3 09:49
既然发消息给我那就编一个。使用时不保证100％正确。
;;; 框选封闭区域面积到excel by:langjs
;;; ＝ ...
能改成输出外形长宽尺寸到EXCEL
hao3ren 发表于 2012-7-4 00:01
;;; 框选封闭区域面积到excel by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:qq (/ d ...
辛苦了~感谢分享，最后个括号多了。
加入是否输出Excel选项就完美了？