[求助]修改弧长标注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 (< a1 a2) (left)
                  (right)
               )
(prompt "\n输入尺寸线的位置：")
   (command "dim" "angular" "" cen ep ep1 pause (rtos arclen) pause "exit")
         )
   (prompt "\n所选实体不是弧")
)
(setvar "clayer" "0")
(setvar "cmdecho" 1)
(setvar "blipmode" 0)
                     (princ)
)
   (prompt "\n键入ARCDIM唤起命令： ")

CAD菜鸟 发表于 2003-1-7 10:38:00

[建议]

将(command "dim" "angular" "" cen ep ep1 pause (rtos arclen) pause "exit")改为
(command "dim" "angular" "" cen ep ep1 pause (rtos arclen) "" "exit")即可，但有一个问题，用"dim" "angular"时，并非提示相同的两次，第一次提示尺寸线的位置，第二次提示文字的位置，若第二次提示时采用默认值，则文字标注在尺寸线的中间位置。

东哥发表于 2003-1-7 11:39:00

不行！

谢谢你的热情，只是好像没有达到目的。你可能没亲自做一下，体会体会这样的标注是什么感觉。虽然系统提示第一次提示尺寸线的位置，第二次提示文字的位置，但其实第一次是无效的，第二次仍可改变尺寸线位置，并同时可手动放置文字位置。而你的方案中添加了一个回车，实际执行结果是多了个重复执行上一命令。

CAD菜鸟 发表于 2003-1-7 11:55:00

我将你的程序在CAD2002中试过。。。

没问题，我的方案中不是添加了一个回车，而是将第二个PAUSE改为回车的，你在试试。

alin 发表于 2003-1-7 13:15:00

It works now...

(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 "\nSelect an arc: "))
   (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 (< a1 a2) (left)
                  (right)
               )
   (prompt "\nLocation of dimesion line:")
   (command "_dimangular" "" cen ep ep1 pause)
(setq arcdimobj (vlax-ename->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: ")

东哥发表于 2003-1-7 14:16:00

不错，多谢了！

东哥发表于 2003-1-7 14:19:00

多谢，也能成，只是有一点小问题

执行完后有一个错误提示。
错误: no function definition: VLAX-ENAME->VLA-OBJECT

tuger 发表于 2003-1-15 00:58:00

这里有你要的弧长标注程序，简单方便

这里有你要的弧长标注程序，简单方便，命令zxda
http://www.xdcad.net/forum/showthread.php?s=&threadid=24873

lichenxui 发表于 2011-12-10 23:24:15

收藏了感谢分享

lichenxui 发表于 2011-12-10 23:24:49

收藏了感谢分享

页: [1]

明经CAD社区's Archiver