注册 发表于 2013-3-10 08:01:18

mini有此功能，挺好用

461045462 发表于 2013-3-10 12:21:51

mjjs ; 错误: no function definition: MKLA

skg123 发表于 2013-5-13 21:25:10

香田里浪人 发表于 2013-1-13 18:00 static/image/common/back.gif
我在2004中确实能运行，不知你们cad版本。我也没有收钱，哪来坑人吗？

2004也不能运行，楼主再修改一下

香田里浪人 发表于 2013-5-14 20:00:10

;;;;面积批量计算（不闭合可计算）
(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))      
       )
   )
   )

注册 发表于 2013-5-15 15:53:17

香田里浪人 发表于 2013-5-14 20:00 static/image/common/back.gif
;;;;面积批量计算（不闭合可计算）
(defun c:mjpljs(/ ACADDOC ACADSPC OBJAREA OBJLLPOINT OBJRUPOINT SE ...

大哥，单位好像是错误的呢，10米*10米=

香田里浪人 发表于 2013-5-15 18:48:05

默认单位采用米，若采用mm，请自己调整。

luminace 发表于 2013-5-15 23:05:23

谢谢下载了~~

GamIng 发表于 2013-5-16 08:55:39

香田里浪人 发表于 2013-5-14 20:00 static/image/common/back.gif
;;;;面积批量计算（不闭合可计算）
(defun c:mjpljs(/ ACADDOC ACADSPC OBJAREA OBJLLPOINT OBJRUPOINT SE ...

输入文字高度、编号前缀、起始编号过程太麻烦。最好是能有些默认或记忆的参数，直接出结果。

comechris 发表于 2013-8-27 01:02:55

香田里浪人 发表于 2013-5-14 20:00 static/image/common/back.gif
;;;;面积批量计算（不闭合可计算）
(defun c:mjpljs(/ ACADDOC ACADSPC OBJAREA OBJLLPOINT OBJRUPOINT SE ...

很不错的程序，谢谢分享

清风明月名字 发表于 2013-8-27 14:31:10

谢谢楼主的分享，试用了，非常好，收藏备用了！
页: 1 [2] 3 4
查看完整版本: 闭合多义线面积批量标注