- ;; 命令: TT
- (defun C:TT (/ AREA E ELIST LST N NUM SS TEXT TEXTPT TEXTSIZE TOTAL)
- (princ "\n按比例分摊承包合同面积标注")
- (princ "\n作者:carrot1983 QQ:95818608 2015年01月09日")
- (command ".-LAYER" "M" "分摊面积标注" "C" 2 "分摊面积标注" "")
- (princ "\n选择三个地块的面积数字")
- (if (and (setq SS (ssget '((0 . "TEXT")
- (8 . "面积标注")
- (1 . "~*[~`--9]*")
- )
- )
- )
- (setq AREA (getreal "\n输入已知的承包合同面积<退出>: "))
- )
- (progn
- (setq LST NIL)
- (repeat (setq N (sslength SS))
- (setq E (ssname SS (setq N (1- N))))
- (setq ELIST (entget E))
- (setq NUM (atof (cdr (assoc 1 ELIST))))
- (setq LST (cons (list E NUM) LST))
- )
- (setq TOTAL (apply '+ (mapcar 'cadr LST)))
- (foreach X LST
- (setq E (car X))
- (setq NUM (cadr X))
- (setq TEXT (rtos (/ (* NUM AREA) 1.0 TOTAL) 2 2))
- (setq ELIST (entget E))
- (setq TEXTSIZE (cdr (assoc 40 ELIST)))
- (setq TEXTPT (cdr (assoc 10 ELIST)))
- (setq TEXTPT (polar TEXTPT (* 1.5 pi) (* 1.1 TEXTSIZE)))
- (setq ELIST (subst (cons 1 TEXT)
- (assoc 1 ELIST)
- ELIST
- )
- )
- (setq ELIST (subst (cons 8 "分摊面积标注")
- (assoc 8 ELIST)
- ELIST
- )
- )
- (setq ELIST (subst (cons 10 TEXTPT)
- (assoc 10 ELIST)
- ELIST
- )
- )
- (entmake ELIST)
- )
- )
- )
- (princ)
- )
|