本帖最后由 自贡黄明儒 于 2014-1-20 14:50 编辑
向楼主学习,我也来一个上下标注
- (defun C:mybz (/ HAND MOBJ MSPACE MTEXTH MTEXTOBJ OBJ P1 P2 PT2 PT3 PTS)
- (defun gx (obj vlrobj data / AOBJ INSPT P1 PT1)
- (if (and (not (vlax-erased-p obj))
- (setq Aobj (vlax-get-property obj 'Annotation))
- ) ;判断对象是否被删除
- (progn
- (setq pt1 (vlax-get-property obj 'Coordinate 0))
- (setq p1 (vlax-safearray->list (vlax-variant-value pt1)))
- (vlax-put Aobj 'TextString (strcat "X=" (rtos (car p1) 2 1)))
- (setq insPT (vlax-get Aobj 'InsertionPoint))
- (setq obj (vlax-ename->vla-object (handent (car (vlr-data vlrobj)))))
- (vlax-put obj 'TextString (strcat "Y=" (rtos (cadr p1) 2 1)))
- (setq MtextH (* (getvar "DIMSCALE") (getvar "DIMTXT")))
- (vlax-put obj 'InsertionPoint (mapcar '- insPT (list 0 (+ MtextH 2) 0)))
- )
- )
- )
- (setq mSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
- (setq MtextH (* (getvar "DIMSCALE") (getvar "DIMTXT"))) ;文字高度为当前标柱样式文字高度*全局比例
- (setq p1 (getpoint "\n选择要标注的点:"))
- (setq p2 (getpoint p1 "\n选择标注文字位置:"))
- (setq pt2 (vlax-3D-point p2))
- (setq pt3 (vlax-3D-point (mapcar '- p2 (list 0 (+ MtextH 0.5)))))
- (setq Mtextobj (vla-addMtext mSpace pt2 0.0 (strcat "X=" (rtos (car p1) 2 1))))
- (vlax-put Mtextobj 'Height MtextH)
- (setq Mobj (vla-addMtext mSpace pt3 0.0 (strcat "Y=" (rtos (cadr p1) 2 1))))
- (vlax-put Mobj 'Height MtextH)
- (setq hand (vlax-get Mobj 'Handle))
- (if (> (car p1) (car p2))
- (progn(vlax-put Mtextobj 'AttachmentPoint 9)(vlax-put Mobj 'AttachmentPoint 9))
- (progn(vlax-put Mtextobj 'AttachmentPoint 7)(vlax-put Mobj 'AttachmentPoint 7))
- )
- (vlax-put Mtextobj 'InsertionPoint p2);(vlax-put-property Mtextobj 'InsertionPoint pt2)
- (setq pts (vlax-make-safearray vlax-vbDouble '(0 . 5)))
- (vlax-safearray-fill
- pts
- (list (car p1) (cadr p1) (caddr p1) (car p2) (cadr p2) (caddr p2))
- )
- (setq obj (vla-Addleader mSpace pts Mtextobj acLineWithArrow))
- (vlr-object-reactor (list obj) (list hand) '((:vlr-modified . gx)))
- (princ)
- )
|