[编程申请]：eachy 兄，我用的是天正5.5，切盼答复！

hrbpkf

很想将天正的TAPARTAREA命令与下一段（多义线面积标注）命令连接起来，即执行完TAPARTAREA命令后直接完成面积标注命令。
(DEFUN C:vv () ;;;框选 PLINE 线计算面积
(SETQ M (SSGET))
(MJJS))

(DEFUN MJJS ()
(if (= csd nil)
(setq csd 3))
(if (or (= cst nil)(= cst 0))
(setq cst 350))
(setq uu (ssname m 0))
(setq nn (sslength m))
(setq tmj 0 smj 0)
(setq t 0 nnn 0)
(while nnn
(command "area" "e" uu)
(setq ssmj (list (getvar "area")))
(setq smj (car ssmj))
(setq tmj (+ tmj smj))
(setq t (+ t 1))
(setq uu (ssname m t))
(if (= t nn) (setq nnn nil))
)
(if (= ck1 1)
(setq tmmj (rtos (/ tmj 1000000) 2 csd
) )
(setq tmmj (rtos (/ tmj 1000000) 2 csd))
)
(setq po (getpoint "\n请输入标注点位置 : "))
(if (/= cslay nil)
(lmmjs)
(mmmm)
)
)


(defun mmmm ()
(command "text" po cst 0 tmmj)
)

(defun lmmjs ()
(if (or (= cslay "f")(= cslay "F"))
(progn
(setq csl (* 5 cst))
(setq p1 (polar po 0 csl))
)
(progn
(setq a1 (- 0 (/ pi 2)))
(setq p1 (polar po a1 100))
))
(SETVAR "OSMODE" 0)
(command "text" po cst 0 lnm)
(command "text" p1 cst 0 tmmj)

eachy

最初由 hrbpkf 发布
[B]很想将天正的TAPARTAREA命令与下一段（多义线面积标注）命令连接起来，即执行完TAPARTAREA命令后直接完成面积标注命令。
(DEFUN C:vv () ;;;框选 PLINE 线计算面积
(SETQ M (SSGET))
(MJJS))

(DEFUN MJJS ()
... [/B]

在用天正生成轮廓后马上调用本命令

2. 
   
3. (vl-load-com)
   
4. (defun c:vv (/ e area obj pt uu bb)
   
5.   (if (and (setq e (entlast))
   
6.            (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")
   
7.       )
   
8.     (progn
   
9.       (setq area (rtos (/ (vlax-curve-getarea e) 1e6) 2 3)
   
10.             obj         (vlax-ename->vla-object e)
    
11.       )
    
12.       (vla-getboundingbox obj 'bb 'uu)
    
13.       (setq pt (mapcar '(lambda (a b) (/ (+ a b) 2))
    
14.                        (safearray-value bb)
    
15.                        (safearray-value uu)
    
16.                )
    
17.       )
    
18.       (entmake (list '(0 . "text")
    
19.                      '(100 . "acdbentity")
    
20.                      '(100 . "acdbtext")
    
21.                      (cons 10 pt) ;_ insertionpoint
    
22.                      (cons 1 area) ;_ textstring
    
23.                      (cons 40 350.) ;_ height
    
24.                      (cons 8 "_$earea");_ layer
    
25.                )
    
26.       )
    
27.     )
    
28.   )
    
29.   (princ)
    
30. )
    

<br /> (vl-load-com)<br /> (defun c:vv (/ e area obj pt uu bb)<br />   (if (and (setq e (entlast))<br />            (= (cdr (assoc 0 (entget e))) "LWPOLYLINE")<br />       )<br />     (progn<br />       (setq area (rtos (/ (vlax-curve-getarea e) 1e6) 2 3)<br />             obj         (vlax-ename->vla-object e)<br />       )<br />       (vla-getboundingbox obj 'bb 'uu)<br />       (setq pt (mapcar '(lambda (a b) (/ (+ a b) 2))<br />                        (safearray-value bb)<br />                        (safearray-value uu)<br />                )<br />       )<br />       (entmake (list '(0 . "text")<br />                      '(100 . "acdbentity")<br />                      '(100 . "acdbtext")<br />                      (cons 10 pt) ;_ insertionpoint<br />                      (cons 1 area) ;_ textstring<br />                      (cons 40 350.) ;_ height<br />                      (cons 8 "_$earea");_ layer<br />                )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

hrbpkf

ok，多谢eachy兄，搞定了！