[求助]修改弧长标注lisp程序

东哥 · 发表于 2003-1-7 08:49:00

问题：以下程序在执行时最后提示“输入尺寸线位置”要做两遍，我希望只要做一次就可以。不知怎么改？（可能和原程序的运行方式：  "dim" "angular" 的执行方式有关？）
(defun dtr (x)
      (* pi (/ x 180.00))
      )
      (defun rtd (y)
      (/ (* 180 y) pi)
      )
   (defun right ()
      (setq ang1 (angle ep cen)
            ang2 (angle ep1 cen)
            ang (- ang1 ang2)
            arclen (abs(* rad ang))
      )
      )
      (defun left ()
      (setq ang (- a1 a2))
      (setq arclen (abs(* rad ang)))
      )
      (defun C:arcdim (/ ang1 ang2 ang arclen rad pick_pt pick_ang
      cen pick_pt extpt1 extpt2 extpt3 extpt4 ep a1 a2 ep1 e6 e7 ent4 temp_pt1
      temp_pt2 temp_pt3 temp_pt4 e1 e2 e3 e4 text_ang th txt1 txt e5 ep1a epa
      ep1a1 epa1 search )
      (setvar "cmdecho" 0)
      (setvar "blipmode" 0)
      (setq cn (entsel "\n选择要标注的弧： "))
      (setq dn (car cn))
      (setq aw (entget dn))
      (setq ty (cdr (assoc 0 aw)))
   (if (= ty "ARC")
      (progn
      (setq a1 (cdr (assoc 50 aw)))
      (setq a2 (cdr (assoc 51 aw)))
      (setq cen (cdr (assoc 10 aw))
            rad (cdr (assoc 40 aw)))
      (setq ep (polar cen (cdr (assoc 50 aw)) rad)
            ep1 (polar cen (cdr (assoc 51 aw)) rad))
               (if (vla-object (entlast)))
      (if (vlax-property-available-p arcdimobj 'Textoverride)
         (vla-put-Textoverride arcdimobj (rtos arclen))
      )
      )
      (prompt "\nIt's not an arc")
)
(setvar "clayer" "0")
(setvar "cmdecho" 1)
(setvar "blipmode" 0)
                     (princ)
)
      (prompt "\nType 'ARCDIM' to invoke the command: ")