cxs259 发表于 2013-4-22 12:43 
详见附图,谢谢!
 - (defun c:tt (/ S1 S2 PT H N OBJ STRD A LST1 LST2 AA BB K)
- (while (and
- (progn
- (princ "\n选择水平标注:")
- (setq s1 (ssget '((0 . "DIMENSION"))))
- )
- (progn
- (princ "\n选择垂直标注:")
- (setq s2 (ssget '((0 . "DIMENSION"))))
- )
- (setq pt (getpoint "\n标注放置位置:"))
- )
- (setq H (getreal "\n标注高度<1000>:"))
- (if (null h) (setq h 1000))
- (repeat (setq n (sslength s1))
- (setq obj (vlax-ename->vla-object (ssname s1 (setq n (1- n)))))
- (setq strd (rtos (vla-get-Measurement obj) 2 0))
- (if (setq a (assoc strd lst1))
- (setq lst1 (subst (cons strd (1+ (cdr a))) a lst1))
- (setq lst1 (cons (cons strd 1) lst1))
- )
- )
- (repeat (setq n (sslength s2))
- (setq obj (vlax-ename->vla-object (ssname s2 (setq n (1- n)))))
- (setq strd (rtos (vla-get-Measurement obj) 2 0))
- (if (setq a (assoc strd lst2))
- (setq lst2 (subst (cons strd (1+ (cdr a))) a lst2))
- (setq lst2 (cons (cons strd 1) lst2))
- )
- )
- (foreach a lst1
- (setq aa (car a) n (cdr a))
- (foreach b lst2
- (setq bb (car b) k (cdr b))
- (entmake
- (list '(0 . "text")
- '(100 . "AcDbEntity")
- '(67 . 0)
- '(8 . "COLOR2")
- '(100 . "AcDbText")
- (cons 10 pt)
- (cons 1 (strcat aa "X" bb "=" (itoa (* n k))))
- (cons 40 h)
- )
- )
- (setq pt (polar pt (* 1.5 pi) (* 1.5 h)))
- )
- )
-
- )
- (princ)
- )
|