寻找LISP区域和
大家好，我是论坛新手。
我搜索一个非常简单的LISP，它插入（在对象的中心或底部，无论）矩形或闭合线的面积和周长的文本。
e、 g.面积-“1.23 m2”，周长-“2.45 m”
最好是当我可以选择更多的对象，而不是所有选定的文本将被写入。
这两个参数的函数应该写在一起。并不是说我必须首先使用一个命令而不是第二个命令。
字体高度应该可以更改。
精度应为：0001m或0,01m。
有人能帮我吗？
对不起我的英语
谢谢 对于“闭合线”，使用第一个命令：BOUNDARY=>PolyLines。
然后试试这个：
(DEFUN C:AreaPer ( / ar coHt coDec eN i lStrA lStrP p pr pMin pMax osm sel sL strA strP ti uL ) ;dec hT
(princ "\n C:AreaPer: V:17 . 04 . 2014;")
(or (vl-Load-Com))
(setVar "CmdEcho" 0)
(setVar "OrthoMode" 0)
(princ "\n Select Objects : [ Arc, Circle, LwPolyline, PolyLine, ] ;")
(if (setq sel (ssGet '((0 . "Arc,Circle,LwPolyline,PolyLine,SplineX")) ) )
(progn
(if (not (numberP hT)) (setq hT 0.1))
(if (not (numberP dec)) (setq dec 3))
(setq coHt (getString (strcat "\n FontHeight:< Enter = " (RtoS hT 2 3) " >:"))
coDec (getString (strcat "\n Precission :< Enter = " (ItoA dec) " >:"))
osm (getVar "osMode")uL (getVar "insUnits")
strA "Area"lStrA (cons 8 strA)strP "Perimeter"lStrP (cons 8 strP)i -1)
(if (/= coHt "") (setq hT (AtoF coHt)) )
(if (/= coDec "") (setq dec (fix (AtoF coDec))) )
; 0 = Unspecified (No units) , 1=Inches , 4=mm , 5= cm ; 6=m ; 7=km.
(setq ti (car (_VL-Times))
sL (cond ((= uL 1) 2.54e-2) ; inch
((= uL 2) 0.3048) ; feet
((= uL 3) 1609.344) ; miles
((= uL 4) 1e-3) ; mm
((= uL 5) 1e-2) ; cm
((= uL 6) 1.00) ; m
((= uL 7) 1e+3) ; km
(T 1.00)
)) ;_ end of setq
(setVar "osMode" 0)
(vl-cmdF "_.Layer" "n" "Area,Perimeter" "c" 1 "Area" "c" 5 "Perimeter" "")
(command "_.Style" "Arial" "Arial" "0" "1" "0" "N" "N") ;_ end of c
(acet-ui-Progress "Processing : " (ssLength sel))
(repeat (ssLength sel)
(setq i (1+ i)eN (vlax-eName->Vla-Object (ssName sel i)) )
(if (vlax-Property-Available-P eN "Area")
(progn
(setq ar (* (vla-Get-Area eN) sL sL)tip (substr (vla-Get-ObjectName eN) 5)
pr (* (cond ((vlax-Property-Available-P eN "Length") (vla-Get-Length eN))
((vlax-Property-Available-P eN "Circumference") (vla-Get-Circumference eN))
((vlax-Property-Available-P eN "ArcLength") (vla-Get-ArcLength eN))
;;; ((vlax-Property-Available-P eN "Perimeter") (vla-Get-Perimeter eN))
(T 0)
) sL)
) ;
(prinC (strCat "\n" (ItoA i) " : " tip ":Area = " (RtoS ar 2 dec) "m²;Perimeter = " (RtoS pr 2 dec) " m ;"))
(vla-GetBoundingBox eN 'pMin 'pMax)
(setq p (mapcar '/ (mapcar '+ (vlax-SafeArray->List pMin) (vlax-SafeArray->List pMax)) '(2. 2. 2.)))
(entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrA '(7 . "Arial") '(72 . 4) '(10 0 0 0) (cons 1 (strcat "A = " (RtoS ar 2 dec) " m²")) (cons 11 p) ) )
(entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrp '(7 . "Arial") '(72 . 4) '(10 0 0 0) (cons 1 (strcat "P = " (RtoS pr 2 dec) " m")) (cons 11 (mapcar '- p (list 0 hT 0))) ) )
)) ; if
(acet-ui-Progress -1)
) ; r
(acet-ui-Progress)
(setVar "osMode" osm)
)) ; if
;;; (setVar "cLayer" "0")
(princ (strCat "\n Objects:" (ItoA i) "; Time:" (RtoS (/ (- (car (_VL-Times)) ti) 1000.) 2 2) " s;"))
(princ "\n C:AreaPer:END;")
(setVar "CmdEcho" 1)
(princ)
)
非常感谢！
有可能改变比例吗？
e、 g.我在“mm”中绘制，然后使用LISP，它显示：“1000000 m2”，它应该是：“1 m2” 我修改了程序。
必须使用以下命令设置长度单位：Units，
因为它们的值取自AutoCAD变量：（getVar“insUnits”） 谢谢谢谢谢谢
如何更改字体颜色？
如何更改文本的位置？ 1.这将创建层；查找它：
(vl-cmdF "_.Layer" "n" "Area,Perimeter" "c" 1 "Area" "c" 5 "Perimeter" "")
1=红色；
5=蓝色；
放上你喜欢的颜色。
2.
表面文字是否插入中间？你把它们放在哪里？附着DWG示例。
或模式标记=对齐（左中、中、中、右下）？ “油漆”中的示例：
这是可能的，但更复杂。如何处理圆或圆的弧？
矩形是否倾斜、旋转或不规则？
你有权利。这很复杂。
但我通常使用这样的对象：
可以为我制作第二个LISP版本吗？
谢谢 如果你坚持，看：
(defun C:AreaPer ( / ar coHt coDec coTP eN hT2 i lStrA lStrP lTa p pr pMin pMax osm sel sL strA strP tD ti tO uL ) ;dec hT
(princ "\n C:AreaPer: V:17 . 04 . 2014;")
(or (vl-Load-Com))
(setVar "CmdEcho" 0)
(setVar "OrthoMode" 0)
(princ "\n Select Objects : [ Arc, Circle, LwPolyline, PolyLine, ] ;")
(if (setq sel (ssGet '((0 . "Arc,Circle,LwPolyline,PolyLine,SplineX")) ) )
(progn
(if (not (numberP hT)) (setq hT 1.)) ; Real
(if (not (numberP dec)) (setq dec 3)) ; Integer
(setq coHt (getString (strcat "\n FontHeight:< Enter = " (RtoS hT 2 3) " >:"))
coDec (getString (strcat "\n Precission :< Enter = " (ItoA dec) " >:"))
coTP (getString (strcat "\n Text Position :Any = Center; <Enter =Right>:"))
osm (getVar "osMode")uL (getVar "insUnits")
strA "Area"lStrA (cons 8 strA)strP "Perimeter"lStrP (cons 8 strP)i -1)
(if (/= coHt "") (setq hT (AtoF coHt)) )
(if (/= coDec "") (setq dec (fix (AtoF coDec))) )
; 0 = Unspecified (No units) , 1=Inches , 4=mm , 5= cm ; 6=m ; 7=km.
(setq ti (car (_VL-Times))hT2 (* hT 2.) ) ;_ end of setq
(cond ((= uL 0) (setq sL 1.00tO "Unitless"))
((= uL 1) (setq sL 2.54e-2tO "Inch"))
((= uL 2) (setq sL 0.3048tO "Feet"))
((= uL 3) (setq sL 1609.344tO "Miles"))
((= uL 4) (setq sL 1e-3tO "mm"))
((= uL 5) (setq sL 1e-2tO "cm"))
((= uL 6) (setq sL 1.00tO "m"))
((= uL 7) (setq sL 1e+3tO "Km"))
(T (setq sL 1.00tO "Any"))
) ;_ end of c
(alert (strCat "DWGLengthUnitsis:\n\n" (ItoA uL) "=" tO ";\n\nFactor=" (RtoS sL 2 9) "!"))
(setVar "osMode" 0)
(vl-cmdF "_.Layer" "n" "Area,Perimeter" "c" 1 "Area" "c" 5 "Perimeter" "")
(command "_.Style" "Arial" "Arial" "0" "1" "0" "N" "N") ;_ end of c
(acet-ui-Progress "Processing : " (ssLength sel))
(repeat (ssLength sel)
(setq i (1+ i)eN (vlax-eName->Vla-Object (ssName sel i)) )
(if (vlax-Property-Available-P eN "Area")
(progn
(setq ar (* (vla-Get-Area eN) sL sL)tip (substr (vla-Get-ObjectName eN) 5)
pr (* (cond ((vlax-Property-Available-P eN "Length") (vla-Get-Length eN))
((vlax-Property-Available-P eN "Circumference") (vla-Get-Circumference eN))
((vlax-Property-Available-P eN "ArcLength") (vla-Get-ArcLength eN))
;;; ((vlax-Property-Available-P eN "Perimeter") (vla-Get-Perimeter eN))
(T 0)
) sL)
) ;
(prinC (strCat "\n" (ItoA i) " : " tip ":Area = " (RtoS ar 2 dec) "m²;Perimeter = " (RtoS pr 2 dec) " m ;"))
(vla-GetBoundingBox eN 'pMin 'pMax)
(setq pMin (vlax-SafeArray->List pMin)pMax (vlax-SafeArray->List pMax)
lTa (cons 1 (strcat "A = " (RtoS ar 2 dec) " m²")) )
(if (= coTP "")
(setq tD (textBox (list lTa (cons 40 hT) '(50 . 0) '(7 . "Arial"))) ; (caar td)
p (list (- (car pMax) (caadr td)) (+ (cadr pMin) hT2)))
(setq p (mapcar '/ (mapcar '+ pMin pMax) '(2. 2. 2.)))
) ; if
(entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrA '(7 . "Arial") '(72 . 4) '(10 0 0 0) lTa (cons 11 (mapcar '+ p (list 0 hT2 0))) ) )
(entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrp '(7 . "Arial") '(72 . 4) '(10 0 0 0) (cons 1 (strcat "P = " (RtoS pr 2 dec) " m")) (cons 11 p) ) )
)) ; if
(acet-ui-Progress -1)
) ; r
(acet-ui-Progress)
(setVar "osMode" osm)
)) ; if
;;; (setVar "cLayer" "0")
(princ (strCat "\n Objects:" (ItoA i) "; Time:" (RtoS (/ (- (car (_VL-Times)) ti) 1000.) 2 2) " s;"))
(princ "\n C:AreaPer:END;")
(setVar "CmdEcho" 1)
(princ)
)
据我所知，您不知道AutoLisp。这将是很好的，你学习这种编程语言，很容易，非常有用。
使用AutoCAD时，始终需要程序来帮助您工作。
PS:
今天我去乡下度假至少一周，那里没有互联网。所以我们听到复活节假期后。
页:
[1]
2