- (vl-load-com)
- (defun c:mj (/)
- (setq e (car (entsel "\n 请选择多边形==>> ")))
- (setq e_obj (vlax-ename->vla-object e))
- (vla-getboundingbox e_obj 'minpt 'maxpt)
- (setq p1 (vlax-safearray->list minpt))
- (setq p2 (vlax-safearray->list maxpt))
- (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2));;求两点中点
- (setq mj (rtos (vla-get-area e_obj) 2 3))
- (entmake
- (list '(0 . "TEXT")
- (cons 1 mj)
- (cons 10 mid)
- (cons 40 (* (vla-get-area e_obj) 0.0001))
- )
- )
- (setq wjb (cdr (assoc 5 (entget (entlast)))))
- (setq wjl (list wjb))
- (setq objlt (list e_obj)) ;图元名转换为VLA对象
- (setq vrl (vlr-pers
- (vlr-object-reactor objlt wjl '((:vlr-modified . c-2l)))
- )
- )
- (princ) ;静默退出
- )
- (defun c-2l (notifier-object
- reactor-object
- parameter-list
- /
- )
- (setq mj (rtos (vla-get-area notifier-object) 2 3))
- (vla-getboundingbox notifier-object 'minpt 'maxpt)
- (setq p1 (vlax-safearray->list minpt))
- (setq p2 (vlax-safearray->list maxpt))
- (setq mid (mapcar '(lambda (x y) (/ (+ x y) 2.)) p1 p2)) ;;求两点中点
- (setq we (handent (car (vlr-data reactor-object)))) ;获取文本图元名
- (setq wel (entget we))
- (setq wel (subst (vl-list* 10 mid) (assoc 10 wel) wel))
- (setq wel (subst (vl-list* 1 mj) (assoc 1 wel) wel))
- (setq
- wel (subst (vl-list* 40 (* (vla-get-area notifier-object) 0.0001))
- (assoc 40 wel)
- wel
- )
- )
- (entmod wel) ;更新文本图元表
- )
|