Visual LISP练习--文字标注面积

1291500406

(defun c:bb (/ th ss obj pt pt2 textobj)
(vl-load-com)(setq th (getreal "\n必强提示:字高<100>:"))(if (not th)(setq th 100))(setq ss (ssget '((0 . "HATCH")))i -1)
(if ss(progn(repeat (sslength ss)(setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
(vla-GetBoundingBox obj 'minpt 'maxpt)(setq pt(mapcar '(lambda (x) (/ x 2.0))(mapcar '+
(vlax-safearray->list minpt)(vlax-safearray->list maxpt)))pt2 (vlax-make-safearray vlax-vbDouble '(0 . 2))
textobj(vla-addtext  (vla-get-Modelspace (vla-get-activeDocument (vlax-get-acad-object)))
(strcat "S" (itoa i) "=" (rtos (/ (vla-get-area obj) 1000000) 2 3) "㎡")(vlax-3d-point pt) th)) (vlax-safearray-fill pt2 pt)
(vla-put-Alignment textobj 10)(vla-put-TextAlignmentPoint textobj pt2))))(princ))

bai2000

字高能鼠标量取最好

永不言弃

bai2000 发表于 2019-8-23 09:12
字高能鼠标量取最好

2. 
   
3. [code=lisp](defun c:bb (/ th ss obj pt pt2 textobj)
   
4.   (vl-load-com)
   
5.   (setq th (getdist "\n字高<100>:"))
   
6.   (if (not th)
   
7.     (setq th 100)
   
8.   )
   
9.   (setq        ss (ssget '((0 . "HATCH")))
   
10.         i  -1
    
11.   )
    
12.   (if ss
    
13.     (progn
    
14.       (repeat (sslength ss)
    
15.         (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))
    
16.         (vla-GetBoundingBox obj 'minpt 'maxpt)
    
17.         (setq pt      (mapcar '(lambda (x) (/ x 2.0))
    
18.                               (mapcar '+
    
19.                                       (vlax-safearray->list minpt)
    
20.                                       (vlax-safearray->list maxpt)
    
21.                               )
    
22.                       )
    
23.               pt2     (vlax-make-safearray vlax-vbDouble '(0 . 2))
    
24.               textobj (vla-addtext
    
25.                         (vla-get-Modelspace
    
26.                           (vla-get-activeDocument (vlax-get-acad-object))
    
27.                         )
    
28.                         (strcat        "S"
    
29.                                 (itoa i)
    
30.                                 "="
    
31.                                 (rtos (/ (vla-get-area obj) 1000000) 2 3)
    
32.                                 "㎡"
    
33.                         )
    
34.                         (vlax-3d-point pt)
    
35.                         th
    
36.                       )
    
37.         )
    
38.         (vlax-safearray-fill pt2 pt)
    
39.         (vla-put-Alignment textobj 10)
    
40.         (vla-put-TextAlignmentPoint textobj pt2)
    
41.       )
    
42.     )
    
43.   )
    
44.   (princ)
    
45. )

<br /> [code=lisp](defun c:bb (/ th ss obj pt pt2 textobj)<br />   (vl-load-com)<br />   (setq th (getdist "\n字高<100>:"))<br />   (if (not th)<br />     (setq th 100)<br />   )<br />   (setq        ss (ssget '((0 . "HATCH")))<br />         i  -1<br />   )<br />   (if ss<br />     (progn<br />       (repeat (sslength ss)<br />         (setq obj (vlax-ename->vla-object (ssname ss (setq i (1+ i)))))<br />         (vla-GetBoundingBox obj 'minpt 'maxpt)<br />         (setq pt      (mapcar '(lambda (x) (/ x 2.0))<br />                               (mapcar '+<br />                                       (vlax-safearray->list minpt)<br />                                       (vlax-safearray->list maxpt)<br />                               )<br />                       )<br />               pt2     (vlax-make-safearray vlax-vbDouble '(0 . 2))<br />               textobj (vla-addtext<br />                         (vla-get-Modelspace<br />                           (vla-get-activeDocument (vlax-get-acad-object))<br />                         )<br />                         (strcat        "S"<br />                                 (itoa i)<br />                                 "="<br />                                 (rtos (/ (vla-get-area obj) 1000000) 2 3)<br />                                 "㎡"<br />                         )<br />                         (vlax-3d-point pt)<br />                         th<br />                       )<br />         )<br />         (vlax-safearray-fill pt2 pt)<br />         (vla-put-Alignment textobj 10)<br />         (vla-put-TextAlignmentPoint textobj pt2)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

[/code]

1291500406

bai2000 发表于 2019-8-23 09:12
字高能鼠标量取最好

2006年入门的你，getreal和getdist都没搞懂？

xvjiex

都是高手！

594826903

支持一下虽然2020用不了！