;;DimAlign 标注对齐
;;标注对齐程序，作者李凌志，QQ：49551484
;;可以自动对齐标注线、引出点、标注文字。
;;飞诗修订2010/5/8 修正UCS,去除坐标标注
(defun c:DimAlign (/	      ang	 dot10	    dot10new
		   dot11      dot13	 dot13new   dot14
		   dot14new   dotwznew	 entdim	    entdims
		   entname    index	 numdim	    ptbz
		   ptbzother  ptwz	 ptyq	    ssdim
		   user_only  value70	 value70new
		  )
  (princ "\n选择需要改变的标注:")
  (setq ssdim (ssget '((0 . "DIMENSION"))))
  (or ssdim (fsxm-silenceexit))
  (foreach en (fsxm-ss->enlist ssdim)
    ;;去除坐标标注
    (if	(= "AcDbOrdinateDimension"
	   (vla-get-ObjectName (vlax-ename->vla-object en))
	)
      (ssdel en ssdim)
    )
  )
  (or (/= 0 (sslength ssdim)) (fsxm-silenceexit))
  (if ssdim
    (progn
      (setq
	entdim (entget (ssname ssdim 0))
	numdim (sslength ssdim)
      )
      (if (member '(100 . "AcDbRotatedDimension") entdim)
	(setq ang (cdr (assoc 50 entdim)))
	(setq dot13 (cdr (assoc 13 entdim))
	      dot14 (cdr (assoc 14 entdim))
	      ang   (angle dot13 dot14)
	)
      )
    )
  )
  (vla-StartUndoMark *doc*)
  ;;对齐标注线
  (setq ptbz (getpoint "\n指定标注线位置<不变>:"))
  (if ptbz
    (progn
      (setq ptbz (trans ptbz 1 0))
      (setq ptbzother (polar ptbz ang 100)
	    index     0
      )
      (while (< index numdim)
	(setq entname  (ssname ssdim index)
	      entdims  (entget entname)
	      dot10    (cdr (assoc 10 entdims))
	      dot10new (inters
			 ptbz
			 ptbzother
			 dot10
			 (polar dot10 (+ (* 0.5 pi) ang) 100)
			 nil
		       )
	      index    (1+ index)
	)
	(setq
	  entdims
	   (subst (cons 10 dot10new) (assoc 10 entdims) entdims)
	)
	(entmod entdims)
      )
    )
  )
  ;;对齐引出线
  (setq ptyq (getpoint "\n指定引出线位置<不变>:"))
  (if ptyq
    (progn
      (setq ptyq (trans ptyq 1 0))
      (setq index 0)
      (while (< index numdim)
	(setq entname  (ssname ssdim index)
	      entdims  (entget entname)
	      dot10    (cdr (assoc 10 entdims))
	      dot13    (cdr (assoc 13 entdims))
	      dot14    (cdr (assoc 14 entdims))
	      dot14new (inters
			 ptyq
			 (polar ptyq ang 100)
			 dot14
			 dot10
			 nil
		       )
	      index    (1+ index)
	)
	(if (member '(100 . "AcDbRotatedDimension") entdims)
	  (setq	dot13new (inters
			   ptyq
			   (polar ptyq ang 100)
			   dot13
			   (polar dot13 (angle dot14 dot10) 100)
			   nil
			 )
	  )
	  (setq	dot13new (polar	dot14new
				(angle dot14 dot13)
				(distance dot14 dot13)
			 )
	  )
	)
	(setq
	  entdims (subst (cons 14 dot14new) (assoc 14 entdims) entdims)
	  entdims (subst (cons 13 dot13new) (assoc 13 entdims) entdims)
	)
	(entmod entdims)
      )
    )
  )
  ;;对齐标注文字
  (initget "R")
  (setq ptwz (getpoint "\n指定标注文字位置或仅自定义(R)<不变>:"))
  (if ptwz
    (progn
      (setq ptwz (trans ptwz 1 0))
      (if (and (= (type ptwz) 'STR) (= (strcase ptwz nil) "R"))
	(setq
	  ptwz	    (getpoint "\n选择自定义标注文字位置:")
	  user_only T
	)
      )
      (if (= ptwz nil)
	(exit)
      )
      (setq index 0)
      (while (< index numdim)
	(setq
	  entname    (ssname ssdim index)
	  entdims    (entget entname)
	  dot11	     (cdr (assoc 11 entdims))
	  value70    (cdr (assoc 70 entdims))
	  value70new (if (<= value70 128)
		       (+ value70 128)
		       value70
		     )
	  dotwznew
		     (inters
		       ptwz
		       (polar ptwz ang 100)
		       dot11
		       (polar dot11 (+ (* 0.5 pi) ang) 100)
		       nil
		     )
	  entdims    (subst (cons 11 dotwznew) (assoc 11 entdims) entdims)
	  index	     (1+ index)
	)
	(if (= user_only nil)
	  (setq	entdims	(subst (cons 70 value70new)
			       (assoc 70 entdims)
			       entdims
			)
	  )
	)
	(entmod entdims)
      )
    )
  )
  (vla-EndUndoMark *doc*)
  (princ)
)