此代码为一个简单的文本la
我似乎无法让这三个文本项不是一个在另一个之上：x我已经拿了这个基本文件，并试图用它做一些更详细的事情，它也有同样的问题，但这段代码自1/20以来一直没有被修改过，所以我想知道它是一个系统变量还是什么。即使是在一月份，每隔一段时间，3个文本对象中的一个会在其他文本对象的附近或多段线的顶点处执行自己的操作。我很困惑。
;adapted from code from Jeffery P. Sanders
(defun C:GA()
;turn the system echo off
(setvar "cmdecho" 0)
;UNITS AND PRECISION
(setvar "LUPREC" 0)
(setvar "LUNITS" 2)
(setvar "mtextcolumn" 0)
;layer settings
(if
(not
(tblsearch "layer" "A-FLOOR-IDEN")
)
(command "-layer" "m" "A-FLOOR-IDEN" "C" "GREEN" "A-FLOOR-IDEN" "")
(
)
)
(if
(not
(tblsearch "layer" "A-ANNO-NOTE")
)
(command "-layer" "m" "A-ANNO-NOTE" "C" "8" "A-ANNO-NOTE" "")
(
)
)
(if
(not
(tblsearch "layer" "A-AREA-IDEN")
)
(command "-layer" "m" "A-AREA-IDEN" "C" "YELLOW" "A-AREA-IDEN" "")
(
)
)
;set up a variable to hold the area
(while T
(setq myArea 0)
(setq SpaceType 0)
;select one object
(setq ent(entsel))
(if (car ent)
(progn
;find the area of the polyline
(command "area" "Object" (car ent))
(setq x (getvar "Area"))
(if(setq pt1(getpoint "\n Insertion Point: "))
(progn
(SETVAR "CLAYER" "A-FLOOR-IDEN") ;SETS AREA in Square foot TEXT LAYER CLAYER VARIABLE TO A-FLOOR-IDEN
(command "mtext" pt1 "@6,0" (strcat (rtos x 2 2) " sq ft")"")
(SETVAR "CLAYER" "A-ANNO-NOTE") ;SETS OFFICE TYPE TEXT LAYER CLAYER VARIABLE TO A-ANNO-NOTE
(setq SpaceType(getstring T "\n Enter Space Type "))
(command "mtext" (polar pt1 (* pi 1.5) (* 1.5 (getvar "textsize")))
"@6,0" (strcat SpaceType)"")
(SETVAR "CLAYER" "A-AREA-IDEN") ;SETS OFFICE TYPE TEXT LAYER CLAYER VARIABLE TO A-AREA-IDEN
(setq n (+ n 1))
(command "mtext" (polar pt1 (* pi 1.5) (* -1.5 (getvar "textsize")))
"@6,0" (strcat (rtos n 2 0))"")
)
) ;close the if progn for point selection
) ;close the if
) ;close the if progn for object selection
;close the if progn for space type
;close the if progn for room #
);close the if statement
) ; ends repeat
;reset the system echo variable
(setvar "cmdecho" 1)
;supress the last echo
(princ)
嗨，Utah_Indie，
关于代码的几点：
[列表]
[*]我不依赖于使用面积系统变量来检索对象的面积，而是建议使用ActiveX AREA属性或GetArea Curve函数，如下面的代码所示。
[/列表]
[列表]
[*]如果不连接字符串，则无需使用“strcat”。
[/列表]
[列表]
[*]对多行文字的命令调用将受到ObjectSnap的影响-这可能解释了您遇到的问题。
[/列表]
以下是我的示例：
(defun c:test ( / _Layer _MText a e i p s )
;;----------------------------------------------;;
;;Example © Lee Mac 2011-www.lee-mac.com;;
;;----------------------------------------------;;
(defun _Layer ( n c )
(entmake
(list
(cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2n)
(cons 62 c)
(cons 70 0)
)
)
)
(defun _MText ( p s l )
(entmakex
(list
(cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 8 l)
(cons 10 (trans p 1 0))
(cons 11 (getvar 'UCSXDIR))
(cons 1 s)
(cons 210 (trans '(0. 0. 1.) 1 0 t))
)
)
)
(setq i 0)
(foreach x '(("A-FLOOR-IDEN" 3) ("A-ANNO-NOTE" 8) ("A-AREA-IDEN" 2))
(or (tblsearch "LAYER" (car x)) (apply '_Layer x))
)
(while
(and
(setq e
(ssget "_+.:E:S"
(list (cons 0 "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")
(cons -4 "<NOT")
(cons -4 "<AND")
(cons 0 "POLYLINE")
(cons -4 "<OR")
(cons -4 "&=") (cons 70 16)
(cons -4 "&=") (cons 70 64)
(cons -4 "OR>")
(cons -4 "AND>")
(cons -4 "NOT>")
)
)
)
(setq a (vlax-curve-getArea (ssname e 0)))
(setq *stype*
(cond
(
(eq ""
(setq s
(getstring t
(strcat "\nEnter Space Type"
(if *stype* (strcat " <" *stype* ">: ") ": ")
)
)
)
)
*stype*
)
( s )
)
)
(setq p (getpoint "\nSpecify Insertion Point: "))
)
(_MText p (strcat (rtos a 2 2) " sq ft") "A-FLOOR-IDEN")
(_MText (polar p (/ (* 3. pi) 2.) (* 1.5 (getvar 'TEXTSIZE))) *stype* "A-ANNO-NOTE")
(_MText (polar p (/ pi 2.) (* 1.5 (getvar 'TEXTSIZE))) (itoa (setq i (1+ i))) "A-AREA-IDEN")
)
(princ)
)
(vl-load-com)
李，非常感谢你。这里有一些新命令，当然还有一些一流的教程。我可以将其加载到visual Lisp模块中吗？如果我这样做，它不会将vlax curve getArea或多行文字识别为命令。显然需要更多的辅导，再次感谢。
兰迪 嗨Randy，
不客气，很乐意帮忙。
在Visual LISP编辑器中加载代码时（或者在使用代码时），请确保
在会话期间调用了一次(vl-load-com)以加载Visual LISP函数（我可能应该将其添加到代码中，除非我在ACADDOC.lsp中有它，所以不要注意何时忽略了它）。此外，请注意，“多行文字”不会显示为函数，因为它是用户定义的子函数
李
编辑：将（vl load com）添加到代码中。
页:
[1]