[转帖]弧长标注
(princ "\ndmarc=====dim arc 单段圆弧标注--------lxx.2001.5")
(princ "\ndimarc=====dim arc 圆弧连续标注--------lxx.2001.5")
;;=============================================================
(defun c:dmarc (/ n ent entl rad ans ane ptcen pts pte ang arcl)
(princ "\ndim arc 单段圆弧标注--------lxx.2001.5")
(setq n (getint "\n标注文字小数点后位数lt;2gt;:"))
(if (not n) (setq n 2))
(setq ent (car(entsel "\n选择圆弧:"))
entl (entget ent)
rad (cdr (assoc 40 entl))
ans (cdr (assoc 50 entl))
ane (cdr (assoc 51 entl))
ptcen (cdr (assoc 10 entl))
pts (polar ptcen ans rad)
pte (polar ptcen ane rad)
)
(if (gt; ane ans)
(setq ang (- ane ans))
(setq ang (ane (- (* 2 PI) ans)))
)
(setq arcl (rtos (* rad ang) 2 n))
(command "dim" "an" "" ptcen pts pte pause arcl "" "e")
(princ)
)
;;=============================================================
(defun c:dimarc (/ n ent entl rad ptcen roop ptoff pts pte ans ane roff ang arcl)
(princ "\ndim arc 圆弧连续标注--------lxx.2001.5")
(setq n (getint "\n标注文字小数点后位数lt;2gt;:"))
(if (not n) (setq n 2))
(setq ent (car(entsel "\n选择圆弧:"))
entl (entget ent)
rad (cdr (assoc 40 entl))
ptcen (cdr (assoc 10 entl))
roop "true"
ptoff (getpoint "\n标注延伸线偏移点:")
)
(getarcl)
(command "dim" "an" "" ptcen pts pte pause arcl "")
(while roop
(getarcl)
(if (not pte)
(setq roop nil)
(progn
(command "co" pte)
(setq entl (entget(entlast))
entl (subst (cons 1 arcl) (assoc 1 entl) entl)
)
(entmod entl)
);end progn
)
);;end while
(command)
(princ)
)
;;getarcl
(defun getarcl ()
(if (not pts) (setq pts (getpoint "\n标注起点:")) )
(if pte (setq pts pte))
(setq pte (getpoint "\n标注终点:")
ans (angle ptcen pts)
ane (angle ptcen pte)
)
(if ptoff (setq roff (distance ptcen ptoff);;;;;;;标注美化
pts (polar ptcen ans roff)
pte (polar ptcen ane roff)
)
)
(if (gt; ane ans)
(setq ang (- ane ans))
(setq ang (ane (- (* 2 PI) ans)))
)
(setq arcl (rtos (* rad ang) 2 n))
)