区域命令帮助？
你好任何人都可以编写autolisp以使用area命令并将结果作为文本字符串插入绘图区域吗 这应该让你开始：
(command "_AREA" pause)
(setq MyArea (getvar "AREA"))
注意RTOS函数以所需格式进行字符串转换。
Regads，
米尔恰 真的很简单。。但是
单位？
区域信息的来源是什么？实体？从读取外部文件？属性块中的值？
(defun c:GetArea (/ area sset)
(vl-load-com)
(ssget);<--- insert filter here
(setq area 0)
(vlax-for H (setq sset (vla-get-activeselectionset
(vla-get-activedocument
(vlax-get-acad-object))))
(setq area (+ (vla-get-area h) area))
)
(vla-delete sset)
(alert
(strcat
"\nTotal area = "
(if (or (= (getvar "lunits") 3)
(= (getvar "lunits") 4))
(strcat
(rtos area 2)
" sq. in. ("
(rtos (/ area 144) 2)
" sq. ft.)")
(rtos area))))
)
记住：按顺序选择点
用这些条件写出来会很好
通过窗口选择选择点
对点进行排序（以某种方式）
仅从点导出面积（不创建pline）
给出面积/周长
现在编写代码很有趣 再看一遍这篇文章，我觉得我有点过火了 ..................区域起点。LSP 远不及艾伦的优雅
但它应该起作用：
(defun c:AreaFromPoints (/ PtList i area)
(defun LWPoly (lst cls)
(entmakex (append (list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length lst))
(cons 70 cls))
(mapcar (function (lambda (p) (cons 10 p))) lst))))
(setq pts (ssget ":L" '((0 . "POINT"))))
(repeat (setq i (sslength pts))
(setq PtList (cons
(cdr (assoc 10 (entget (ssname pts (setq i (1- i)))))) PtList)
)
)
(Lwpoly PtList 1)
(setq area (vla-get-area (vlax-ename->vla-object (entlast))))
(entdel (entlast))
(princ
(strcat
"\nTotal area = "
(if (or (= (getvar "lunits") 3)
(= (getvar "lunits") 4))
(strcat
(rtos area 2)
" sq. in. ("
(rtos (/ area 144) 2)
" sq. ft.)")
(rtos area)))
)
(princ)
)
-大卫 谢谢大家
我的目标是使用autocad命令\u measuregeom（精确地说是area），但我希望将此autocad命令的结果作为文本插入绘图区域。我有办公室、餐厅和房间的计划。
我想计算并输入前面提到的每一个的面积值，以用于以后的冷负荷计算。（暖通空调）
我希望你已经明白我想要什么。
可能有点像附件
获取区域。lsp
;=======================================================================
; DYN-Area.Lsp Aug 12, 2011
; Dynamic Area Calulations
;================== Start Program ======================================
(princ "\nCopyright (C) 1990-2011, Fabricated Designs, Inc.")
(princ "\nLoading DYN-Area v1.0 ")
(setq dya_ nil lsp_file "DYN-Area")
;++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun dya_smd ()
(SetUndo)
(setq olderr *error*
*error* (lambda (msg)
(while (> (getvar "CMDACTIVE") 0)
(command))
(and (/= msg "quit / exit abort")
(princ (strcat "\nError: *** " msg " *** ")))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END" "_.U"))
(dya_rmd))
dya_var '(("CMDECHO" . 0) ("COORDS" . 2)
("OSMODE" . 0) ("SORTENTS" . 119)
("BLIPMODE". 0) ("ORTHOMODE". 0)
("SNAPMODE". 0) ("PLINEWID" . 0)
("ELEVATION" . 0) ("THICKNESS". 0)
("CECOLOR" . "BYLAYER")
("CELTYPE" . "BYLAYER")))
(foreach v dya_var
(and (getvar (car v))
(setq dya_rst (cons (cons (car v) (getvar (car v))) dya_rst))
(setvar (car v) (cdr v))))
(princ))
;++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun dya_rmd ()
(setq *error* olderr)
(foreach v dya_rst (setvar (car v) (cdr v)))
(command "_.UNDO" "_END")
(prin1))
;++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
(and (zerop (getvar "UNDOCTL"))
(command "_.UNDO" "_ALL"))
(and (= (logand (getvar "UNDOCTL") 2) 2)
(command "_.UNDO" "_CONTROL" "_ALL"))
(and (= (logand (getvar "UNDOCTL")8)
(command "_.UNDO" "_END"))
(command "_.UNDO" "_GROUP"))
;************ Main Program ***************************************
(defun dya_ (/ olderr dya_var dya_rst sp pl np tl)
(dya_smd)
(initget 1)
(setq sp (getpoint "\n1st Point: "))
(setq pl (list sp))
(while (setq np (getpoint sp "\nNext Point - (Enter to Exit): "))
(setq pl (cons np pl)
tl pl
sp np)
(command "_.PLINE")
(foreach p pl (command p))
(command "_CL")
(command "_.AREA" "_E" (entlast))
(command "_.ERASE" (entlast) "")
(princ (strcat " = " (rtos (getvar "AREA"))))
(redraw)
(repeat (1- (length tl))
(grdraw (nth 0 tl) (nth 1 tl) 2 1)
(setq tl (cdr tl)))
(grdraw (nth 0 tl) np 2 1))
(redraw)
(repeat (1- (length pl))
(grdraw (nth 0 pl) (nth 1 pl) 7 1)
(setq pl (cdr pl)))
(grdraw (nth 0 pl) sp 7 1)
(princ (strcat " = " (rtos (getvar "AREA"))))
(dya_rmd))
;************ Load Program ***************************************
(defun C:DYN-Area () (dya_))
(if dya_ (princ "\nDYN-Area Loaded\n"))
(prin1)
;|================== End Program =======================================
尼塞尔
谢谢Alanjt
你太谦虚了大卫
干得好
你指的是屏幕上的点，而不是实体点
在这种情况下，像这样简单的事情就行了
(mapcar '(lambda (a b) (grdraw a b 7))
(setq lst (if (eq pt "Undo")
(cdr lst)
(cons pt lst)
)
)
(cons (last lst) lst)
)
我想尝试一下_measuregeom方法，不幸的是，我不知道它做什么。您可以在“\u measuregeom”之后立即使用类似的内容
(defun c:test (/ pt1 pt2 pt3 LxW str)
(setq pt1 (getpoint "\nLower Left Corner:")
pt3 (getcorner pt1 "\nLower Upper RigbtCorner:"))
(setq pt2 (list (car pt1) (cadr pt3) 0.0))
(setq LxW (list (distance pt1 pt2) (distance pt2 pt3)))
(setq str
(if (or (= (getvar "lunits") 3)
(= (getvar "lunits") 4))
(strcat
(rtos (/ (apply '* Lxw) 144) 2)
" sq. ft.")
(strcat (rtos (apply '* Lxw)) " m²")
)
)
(command "_text" "_Justify" "_center" "_non" (mapcar (function (lambda (a b) (/ (+ a b) 2.))) pt1 pt3)
(getvar 'TextSize) 0 str)
)
提醒：
（命令“\u text”“\u Justify”“\u center”“\u non”pt（getvar'TextSize）0 str）
如果当前文字样式高度非零，则上面的行将跳过文字高度提示，并将（getvar的TextSize）作为旋转，将0作为STR。
这
这里有一个快速的
(defun c:test (/ str pt)
(setq str
(if (or (= (getvar "lunits") 3)
(= (getvar "lunits") 4))
(strcat
(rtos (/ (getvar "AREA") 144) 2)
" sq. ft.")
(strcat (getvar "AREA") " m²")
)
)
(setq pt (getpoint "\n Select insertion point : "))
(command "_text" "_Justify" "_center" "_non" pt
(getvar 'TextSize) 0 str)
)
我现在需要弄清楚的是，在使用窗口选择时对PontList进行排序。
页:
[1]
2