香田里浪人 发表于 2013-6-10 13:10:18

提取面积编号输入Excel 问题

面积批量计算，但不能输入到Excel ，该如何修改？请高手帮忙。谢谢！程序如下：
(defun c:mjpljs(/ 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输入起始编号:")
)
   (ssget '((0 . "LWPOLYLINE")))
(command "layer" "M" "面积计算" "C" "3" "" "LT" "CONTINUOUS" "" "");设置一个标注图层
(command "style" "tukou" "黑体" "0" "" "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)
      )
       (vla-put-alignment TextObj acAlignmentCenter)
       (vla-put-TextAlignmentPoint TextObj (vlax-3d-point TextBasePoint))
       (setq TextIndex (1+ TextIndex))      
       )
   )
   )

feng83 发表于 2014-5-20 20:19:30

都没人回答。我也很想知道怎么输出到EXCEL

树櫴希德 发表于 2014-9-13 09:29:11

是啊，可惜我不会

树櫴希德 发表于 2014-9-13 09:41:52

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=100205看这个帖子
页: [1]
查看完整版本: 提取面积编号输入Excel 问题