[求助]这个LISP程序如何编写？

r0r

请教龙龙仔版主：加载你这个程序后输入什么命令啊？详细解说！

meflying

你用了这么多程序，到现在还不知道程序的命令是什么？
找到程序的开头，c:后面，括号前面那一串东西就是命令。
注：在程序中（不仅只这个），就是这个程序的c:的地方如果没有出现c:，就是将那个字符串括在括号里使用，如：
(defun test()
(princ "hello")
)
这样调用：(test)

r0r

两位版主辛苦了！如此着心真让人感动！试运行了你们的程序，效果基本满意，离理想中的越来越近了，为了使它完美，有必要再提一下：

还需要改进：
1.在选择直线或圆弧时，光标指向选择对象时是否可让对象变虚线？因为当附近有很多线段时很难分清选择的是哪一条线段，虽然可借助窗口缩放命令放大后选 择，如果使对象变成虚线更直观了。操作此命令时可关闭对象捕捉命令，操作好 后要把对象捕捉命令继续打开（当然原来关闭的也用不着打开，也就是说要恢复
原来的设定壮态）。

2.当选择通过的点时不要关闭对象捕捉命令，因为通过的点绝大多是能捕捉到的点。

3.在实现操作中经动态调整后，已基本确定了相切圆的位置，此时填入了要求的半径值，相切圆的位置应固定下来了，不必再出现另外一边的相切圆了。

4.完成以上相关操作后，CAD的设置必须恢复原来的设定壮态。

发现的问题：过点与直线相切有问题，结果出现了2个相切圆，1个以点为圆心的圆，再1个以直线一端为圆心的圆。

r0r

是否我要求提得过份了？为了完善程序，我不得不提，请二位谅解！

r0r

53楼内容已改，请注意

龙龙仔

r0r发表于2003-10-30 9:16:0053楼内容已改，请注意

;;解决第1,2 问题

;;当鼠标移动到满足过滤条件的像素上时，像素会闪动
;;USAGECS_EntSel "\n请选Polyline物件: " '((0 . "*Polyline")))
;;出自某人(忘了)
(defun CS_ENTSEL (STR FILTER / PT SS_NAME SS)
  (if (/= (type STR) 'STR)
    (progn
      (princ "\n变量类型不对，STR应为字符串。\n")
      (eval NIL)
    )
    (progn
      (if (/= (type FILTER) 'list)
        (progn
          (princ "\n变量类型不对，FILTER应为表。\n")
          (eval NIL)
        )
        (progn
          (princ STR)
          (setq PT (grread t 4 2))
          (while (/= 3 (car PT))
            (if        (= 5 (car PT))
              (progn
                (setq PT (cadr PT))
                (setq SS (ssget PT FILTER))
                (if SS_NAME
                  (redraw SS_NAME 4)
                )
                (setq SS_NAME NIL)
                (if SS
                  (progn
                    (setq SS_NAME (ssname SS 0))
                    (redraw SS_NAME 3)
                  )
                )
              )
              (setq PT (grread t 4 2))
            )
          )
          (setq PT (cadr PT))
          (setq SS (ssget PT FILTER))
          (if SS_NAME
            (redraw SS_NAME 4)
          )
          (setq SS_NAME NIL)
          (if SS
            (progn
              (setq SS_NAME (ssname SS 0))
              (list SS_NAME PT)
            )
            (eval CS_NAME)
          )
        )
      )
    )
  )
)

(defun C:DRAWCIRCLE_LAI        (/         QQ1         QQ2         QQ3         QQ4
                         PTT         HOLDECHO         HOLDOSMODE
                         ENT         PT         R         ENTC         ENTL
                         PTS         RARC         PTARC         ENTSS
                        )

  (if (setq QQ1        (CS_ENTSEL "\n选择直线或圆弧..."
                           '((0 . "ARC,CIRCLE,LINE"))
                )
      )
    (progn
      (setq ENT (car QQ1))
      (setq RARC (cdr (assoc 40 (entget ENT))))
      (setq PTARC (cdr (assoc 10 (entget ENT))))
      (setq PT (getpoint "\n输入通过点:"))
      (setq HOLDECHO (getvar "cmdecho"))
      (setvar "cmdecho" 0)
      (setq HOLDOSMODE (getvar "osmode"))
      (setvar "osmode" 0)
      (setq QQ2 (cadr QQ1))
      (setq QQ3 (entlast))
      ;;实时拉动、观察
      (while (= (car (setq PTT (grread 2 4))) 5)
        (if (not (equal (entlast) QQ3))
          (progn
            (prompt
              (strcat "\r目前圆半径= "
                      (rtos (cdr (assoc 40 (entget (entlast)))) 2 4)
                      "                               "
              )
            )
            (command "_.erase" (entlast) "")
          )
        )
        (command "_.circle" "3p" PT "tan" QQ2 (cadr PTT))
        ;;(command "_.circle" "3p"  PT "tan"  QQ2 (osnap (cadr PTT) "_end,_int,_mid,_qua"))
      )
      (setq QQ4 (entlast))
      (if (not (equal QQ4 QQ3))
        (progn
          (setq R (getdist "\n输入圆半径: "))
          (entdel QQ4)
        )
      )
      (if (and (< (distance PT PTARC) RARC) (> R RARC))
        (exit)
      )
      (command "_.circle" PT R)
      (setq ENTC (entlast))
      (command "_.offset" R ENT PT "")
      (setq ENTL (entlast))
      (if (not (equal ENTC ENTL))
        (progn
          (setq PTS (GETINTERPOINT ENTC ENTL))
          (entdel ENTL)
          (setq ENTSS (DRAW PTS R ENT))
        )
      )
      (if (> R RARC)
        (progn
          (command "_.circle" PTARC (- R RARC))
          (setq ENTL (entlast))
          (setq PTS (GETINTERPOINT ENTC ENTL))
          (setq ENTSS (SSCAT ENTSS (DRAW PTS R ENT)))
          (entdel ENTL)
        )
      )
      (entdel ENTC)
      (while (= (car (setq PT (grread 2 5))) 5)
        (SSREDRAW ENTSS 3)
        (redraw (setq ENTC (GETCLOSEDENT ENTSS (cadr PT))) 4)
      )
      (ssdel ENTC ENTSS)
      (command "_.erase" ENTSS "")
      (setvar "osmode" HOLDOSMODE)
      (setvar "cmdecho" HOLDECHO)
    )
  )
  (princ)
)

龙龙仔

发现的问题：过点与直线相切有问题，结果出现了2个相切圆，1个以点为圆心的圆，再1个以直线一端为圆心的圆。

修改下列試試
;;(if (> R RARC)
  (if (and (/= RARC NIL) (> R RARC))

r0r

各位注意：
龙龙仔与meflying俩版主正在完善这个程序，需要者请时刻关注！

BDYCAD

樓上最關注這個了. 呵呵 : )

r0r

BDYCAD发表于2003-10-31 9:34:00樓上最關注這個了. 呵呵 : )

以后有机会烦你的，到时你也会领教我的烦功的！