区域lisp
大家好，我想要一个lisp的面积，如果我选择一个，圆，rec，多边形，等等。。lisp想要在图纸上标出面积或周长，请参见exzample
lisp应询问文字高度和面积或周长
请帮帮我
样品pdf 试试这个
~'J'~
[/c(defun C:alb (/ acsp adoc ar axss hgt maxp minp obj p1 p2 pc ss txt)
(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq acsp (vla-get-paperspace adoc))
(setq acsp (vla-get-modelspace adoc))
)
(vla-startundomark (vla-get-activedocument
(vlax-get-acad-object)))
(initget 7)
(setq hgt (getreal "\nEnter text height: "))
(prompt "\nSelect objects on screen to add area label")
(if (setq ss (ssget))
(progn
(setq axss (vla-get-activeselectionset adoc))
(vlax-for obj axss
(if (not
(vl-catch-all-error-p
(setq
ar (vl-catch-all-apply
(function (lambda()
(vlax-curve-getarea obj)))))))
(progn
(setq txt (strcat "Area = " (rtos ar 2 2)))
(vla-getboundingbox obj 'minp 'maxp)
(setq p1 (vlax-safearray->list minp)
p2 (vlax-safearray->list maxp)
pc (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
)
(vlax-invoke acsp 'Addtext txt pc hgt)
)
)
)
)
)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object)))
(princ)
)
(princ "\nType ALB to label objects with area text")
(princ) 这很好，很好
但lisp也向我要perimiter
这样做我很感谢你
哈什哈德：） 请将图片附在
要放置周长文本
你想把它们放在
区域文字下方的第二行或
其他地方？
~'J'~ 尝试编辑的版本
(defun C:alb (/ acsp adoc ar axss hgt maxp minp obj p1 p2 pc1 pc2 per
ss txt1 txt2)
(vl-load-com)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
(setq acsp (vla-get-paperspace adoc))
(setq acsp (vla-get-modelspace adoc))
)
(vla-startundomark (vla-get-activedocument
(vlax-get-acad-object)))
(initget 7)
(setq hgt (getreal "\nEnter text height: "))
(prompt "\nSelect objects on screen to add area label")
(if (setq ss (ssget))
(progn
(setq axss (vla-get-activeselectionset adoc))
(vlax-for obj axss
(if
(and
(not
(vl-catch-all-error-p
(setq
ar (vl-catch-all-apply
(function (lambda()
(vlax-curve-getarea obj)))))))
(not
(vl-catch-all-error-p
(setq
per (vl-catch-all-apply
(function (lambda()
(vlax-curve-getdistatparam obj
(vlax-curve-getendparam obj)))))))))
(progn
(setq txt1 (strcat "Area = " (rtos ar 2 2)))
(setq txt2 (strcat "Perimeter = " (rtos per 2 2)))
(vla-getboundingbox obj 'minp 'maxp)
(setq p1 (vlax-safearray->list minp)
p2 (vlax-safearray->list maxp)
pc1 (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
pc2 (mapcar '- pc1 (list 0 (* hgt 1.5) 0))
)
(vlax-invoke acsp 'Addtext txt1 pc1 hgt)
(vlax-invoke acsp 'Addtext txt2 pc2 hgt)
)
)
)
)
)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object)))
(princ)
)
(princ "\n Type ALB to label objects with area and perimeter text")
(princ)
(C:alb)
~'J'~ 很好，胖子
非常感谢：） 不客气
干杯
~'J'~ 所以我复制了上面的lsp并在稍作修改后使用了它，但在某些情况下遇到了问题。
请参阅附图：
（1） 来自在旋转UCS中绘制的图形，（2）是在另一个图形中生成的边界。边界有一些分割的共线。如果段被替换为单行，则代码有效。事实上，该边界不会生成任何错误消息，但（1）会如下所示：
我对AutoLISP并不陌生，但我也不是它的专业人士。有人能帮我排除故障吗？
我对代码所做的修改是通过拾取现有文本而不是键入文本来生成文本高度，并对齐文本中心。文字高度选取的相关部分为：
请注意，一些变量已更改。我还没有在文本选取中包含错误检查，我希望尽快了解这一点。
谢谢
吉特
编辑：测试文件Test1。dwg是1mb，所以我将其内容复制到一个新的（空白）文件中，名为Test2。图纸和附件。现在（1）正在工作，但（2）仍然不工作。
测试2.dwg 编辑：请忽略。 我很抱歉
我可以稍后再看你的问题
现在我工作很忙
~'J'~
页:
[1]
2