请求高手帮忙解决或修改“自动标注面积周长”的lisp文件，不胜感激！

leeooo

各位高手大侠好！

初学lisp纯粹瞎编的，点击封闭区域自动标注面积周长，正常运行了几天，但之后出现下面的问题无法解决，请求高手达人帮忙解决或者修改lisp，不胜感激！！！

命令:
命令: mj \n请点取要标注的范围内一点:-boundary
指定内部点或 [高级选项(A)]: 正在选择所有对象...
正在选择所有可见对象...
正在分析所选数据...
正在分析内部孤岛...
指定内部点或 [高级选项(A)]:
BOUNDARY 已创建 1 个多段线
命令: MJ 未知命令“MJ”。按 F1 查看帮助。
命令: ; 错误: ActiveX 服务器返回错误: 未知名称: Perimeter
命令:

请求高手达人帮忙解决或者修改lisp或者编个类似的，不胜感激需要修改的代码如下：

(defun C:mj (/  pt a b c s ss tt ttt )
(vl-load-com)
(setq pt (getpoint "\\n请点取要标注的范围内一点:"))
(command "-boundary" pt "" "")
(setq a (entlast))
(setq b (vlax-ename->vla-object a))
(setq s (vla-get-area b))
(setq ss (rtos (/ s 1000000)2 2))
(setq tt (vla-get-perimeter b))
(setq ttt (rtos (/ tt 1000)2 2))
(command "textsize" 200 "")
(command "mtext"  pt pt (strcat "面积=" ss "平米\n" "周长=" ttt "米") "")
(command "erase" a "")
)

Akifans

leeooo 发表于 2009-4-8 09:58
本帖最后由 作者 于 2009-4-8 10:37:49 编辑  无意中看到论坛sailorcwx大侠的，很羡慕，努力学习了，现转 ...

您好，输入的字符串有缺陷

denghui002006

leeooo 发表于 2009-4-8 09:53
已经修改正确，点击区域自动封闭标注面积周长很小的lispdefun C:mj (/  pt a b c s ss tt ttt )(vl- ...

太棒了 可以用 谢谢

wchaop

vla-get-perimeter的对象只能是面域！

leeooo

谢谢大家

对的vla-get-perimeter有问题

改为vla-get-length即可

leeooo

已经修改正确，点击区域自动封闭标注面积周长很小的lisp:

(defun C:mj (/  pt a b c s ss tt ttt )
(vl-load-com)
(setq pt (getpoint "\\n请点取要标注的范围内一点:"))
(command "-boundary" pt "" "")
(setq a (entlast))
(setq b (vlax-ename->vla-object a))
(setq s (vla-get-area b))
(setq ss (rtos (/ s 1000000)2 2))
(setq tt (vla-get-length b))
(setq ttt (rtos (/ tt 1000)2 2))
(command "textsize" 200 "")
(command "mtext"  pt pt (strcat "面积=" ss "平米\n" "周长=" ttt "米") "")
(command "erase" a "")
)

leeooo

无意中看到论坛sailorcwx大侠的，很羡慕，努力学习了，现转帖如下，选择封闭区域，自动编号标注面积，甚是节约时间，比如几千个面积需要标注咋办？用这个lisp很快高效啊，顺便请问如何把周长长度加在面积的下面：

(defun c:markarea(/ 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输入标注文字高度:")
 TextIndex (getint "\n输入起始编号:")
 )
  (ssget '((0 . "LWPOLYLINE")))
  (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 (itoa TextIndex) "号面积=" (rtos ObjArea) "平方米") (vlax-3d-point TextBasePoint) TextHeight)
     )
      (vla-put-alignment TextObj acAlignmentCenter)
      (vla-put-TextAlignmentPoint TextObj (vlax-3d-point TextBasePoint))
      (setq TextIndex (1+ TextIndex))     
      )
    )
  )

leeooo

请问各位高手达人：

如何在面积的下面加上周长，不胜感激，就像下面一样：

 

1号面积=74.00平方米

1号周长=109.69米

2号面积=274.00平方米

3号周长=1109.69米

 

如何把上面很多标注的面积和周长列表统计到excel ,这是很考脑筋的问题，请求帮忙！万分感谢！！！

leeooo

请问各位高手达人：

如何在面积的下面加上周长，不胜感激，就像下面一样

如何把上面很多标注的面积和周长列表统计到excel ,这是很考脑筋的问题，请求帮忙！万分感谢！！！

yuandke

感谢各位老大，这个程序很好，解决了我的不少问题。

接下来有个小问题请教一下大家。

这个程序生成的数字和汉字是“txt.shx”这个字体的

我怎么样才能通过修改这个程序的方法使生成的字体为“宋体”呢！

谢谢各位大大啦！

ljttjl

也可见以下面积和周长标注程序

明经CAD社区 → 工程篇 → 测绘与GIS → 自动标注选择区域的封闭图形的面积和周长程序
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=72983