;;对齐坐标标注文字位置AlignDimOrdinate
;;飞诗2010-8-5修订
(defun c:AlignDimOrdinate (/ obj pt ss mtdor drawline)
  (defun mtdor (dim pt / d line lp lpt1 lpt2 obj tp pt2 prj s)
    (setq d (entget dim))
    (cond ((vl-position '(100 . "AcDbOrdinateDimension") d)
	   (setq lp (fsxm-getdxf 11 d))	;文字
	   (setq tp (fsxm-getdxf 14 d))	;引线
	   (setq obj (vlax-ename->vla-object dim))
	   ;;====================================
	   (setq line (entnext (tblobjname "block" (fsxm-getdxf 2 d))))
	   (setq lpt1 (vlax-curve-getStartPoint line))
	   (setq lpt2 (vlax-curve-getEndPoint line))

	   (setq prj (vlax-curve-getClosestPointTo line pt t))
	   (setq pt2 (fsxm-pt-prj lp pt prj))
	   ;;
	   (setq s (vla-get-VerticalTextPosition obj))
	   (vla-put-VerticalTextPosition obj acVertCentered)
	   (vlax-put obj 'TextPosition pt2)
	   (vlax-put
	     obj
	     'TextPosition
	     (mapcar '+ pt2 (mapcar '- pt2 (fsxm-getendxf dim 14)))
	   )
	   (vla-put-VerticalTextPosition obj s)
	   ;;
	   (drawline pt pt2)
	  )
    )
  )
  (defun drawline (pt1 pt2)
    (grdraw (trans pt1 0 1) (trans pt2 0 1) 2 1)
  )
  (cond	((and (setq pt (getpoint "选择坐标标注对齐点："))
	      (progn (fsxm-pt-grdraw pt 1) t)
	      (setq ss (ssget '((0 . "DIMENSION"))))
	 )
	 (setq pt (trans pt 1 0))
	 (vla-StartUndoMark *doc*)
	 (foreach dim (fsxm-ss->enlist ss)
	   (mtdor dim pt)
	 )
	 (vla-EndUndoMark *doc*)
	)
  )
  (princ)
)