zolly 发表于 2024-11-1 08:14:39

entsel如何按空格或回车退出while循环

新人自学写了一个标记两条直线交点的程序,entsel空选就循环继续选直到选中,请大神们帮我看看怎么按空格或回车能退出循环,不按空格或回车就一直循环选下去。附代码


;标记两条直线交点

(defun c:ttt( / e1 e2 ent1 ent2 p11 p12 p21 p22 pt s1 s2 ss)

(setvar "cmdecho" 0)

(while T

    (setq e1 (entsel "\n选取第一条线:"))

      (while (= e1 nil)

      (setq e1 (entsel "\n选取第一条线:"))      

      )

   

    (setq e2 (entsel "\n选取第二条线:"))

    (while (= e2 nil)

      (setq e2 (entsel "\n选取第二条线:"))      

      )

    (if (and e1 e2)

      (progn

      (setq ent1 (entget(car e1)))

    (setq p11 (cdr (assoc 10 ent1)))

    (setq p12 (cdr (assoc 11 ent1)))

          (setq ent2 (entget(car e2)))

    (setq p21 (cdr (assoc 10 ent2)))

    (setq p22 (cdr (assoc 11 ent2)))

    (setq pt (inters p11 p12 p21 p22 nil))

(if (= pt nil)

    (alert "\n所选的两条线为平行线,重选或退出")

    (progn

      (if (< (distance pt p11) (distance pt p12))

      (command "LINE" pt p11 "")      

      (command "LINE" pt p12 "")      

      )

      (setq s1 (entlast))

      (if (< (distance pt p21) (distance pt p22))

      (command "LINE" pt p21 "")      

      (command "LINE" pt p22 "")      

      )

      (setq s2 (entlast))

      (setq ss (ssadd))

      (ssadd s1 ss)

      (ssadd s2 ss)

      (command "_.scale" ss "" pt 0.35)

      )

    )

)

      )

      

    )

(princ)

)

wzg356 发表于 2024-11-1 11:02:53

手机想象敲的(while(/= ""(progn(initget " ")(entsel ))))

ssyfeng 发表于 2024-11-1 09:04:06

本帖最后由 ssyfeng 于 2024-11-1 10:03 编辑

试试这个,已更新循环执行

ssyfeng 发表于 2024-11-1 10:03:19

zolly 发表于 2024-11-1 09:52
这个选择一次程序就结束了,要完成一次标记后继续循环标记多个,直到按空格或回车跳出循环结束程序,但是 ...

更新循环执行

qazxswk 发表于 2024-11-1 08:41:08

试试用grread函数

zolly 发表于 2024-11-1 08:45:13

qazxswk 发表于 2024-11-1 08:41
试试用grread函数

能帮忙改一下吗?学习一下,自学的,不知道怎么下手

自贡黄明儒 发表于 2024-11-1 09:04:35

(while (and (setq e1 (entsel "\n选取第一条线:")) (setq e2 (entsel "\n选取第二条线:")))
....
)

zolly 发表于 2024-11-1 09:52:36

本帖最后由 zolly 于 2024-11-1 09:54 编辑

ssyfeng 发表于 2024-11-1 09:04
试试这个
这个选择一次程序就结束了,要完成一次标记后继续循环标记多个,直到按空格或回车跳出循环结束程序,但是你这个能使正在选的程序按空格结束,我再看看,谢谢帮助

zolly 发表于 2024-11-1 10:21:29

ssyfeng 发表于 2024-11-1 10:03
更新循环执行

大佬,那个grread那一段看都看不懂,我在外面再嵌套个while程序都运行不了,能不能帮忙完善一下,代码后面如果能注解一下就太感谢了

被承包的东子 发表于 2024-11-1 11:39:49

zolly 发表于 2024-11-1 10:21
大佬,那个grread那一段看都看不懂,我在外面再嵌套个while程序都运行不了,能不能帮忙完善一下,代码后 ...

(defun c:tt(/ code e1 e2 ent1 ent2 loop mag msg n1 n2 p11 p12 p21 p22 pt s1 s2 ss ss1 ss2)

                                (setq loop T N1 nil N2 nil MSG T)
                                (while loop
                                        (setq code (grread T 8) )
                                        (cond
                                                ((= (car code) 5)                                                                                       
                                                        (IF MSG
                                                                (PROGN
                                                                        (princ "点击鼠标左键,进入选择!")
                                                                        (setq MSG nil)
                                                                )
                                                               
                                                        )
                                                )
                                                ((AND (= (car code) 2) (OR (= (cadr code) 32) (= (cadr code) 13)) )
                                                        (princ "\n按键空格或回车,取消操作!")
                                                        (setq loop nil)
                                                )
                                                ((= (car code) 3)                                                                                       
                                                        (setq pt (cadr code))
                                                        (if (and (null n1) (princ "\n请选择第一根直线") (setq sS1 (ssget "_:E" '((0 . "LINE")) )) )
                                                                (PROGN
                                                                        (setq e1 (ssname sS1 0))
                                                                        (setq n1 t)                                                                                                                                               
                                                                )
                                                                (setq e2 nil)                                                               
                                                        )
                                                        (if (and(princ "\n请选择第二根直线") (setq sS2 (ssget "_:E" '((0 . "LINE")) )) )
                                                                (PROGN
                                                                        (setq e2 (ssname sS2 0))
                                                                        (setq n1 nil)
                                                                       
                                                                )
                                                               
                                                        )                                                       
                                                )                                                                                               
                                        )
                                        (if (and e1 e2)                                               
                                                (progn
                                                        ;(setq loop nil)
                                                        (setq ent1 (entget e1))                               
                                                        (setq p11 (cdr (assoc 10 ent1)))                               
                                                        (setq p12 (cdr (assoc 11 ent1)))                               
                                                        (setq ent2 (entget e2))                               
                                                        (setq p21 (cdr (assoc 10 ent2)))                               
                                                        (setq p22 (cdr (assoc 11 ent2)))                               
                                                        (setq pt (inters p11 p12 p21 p22 nil))                               
                                                        (if (= pt nil)                                       
                                                                (alert "\n所选的两条线为平行线,重选或退出")                                       
                                                                (progn                                               
                                                                        (if (< (distance pt p11) (distance pt p12))                                                       
                                                                                (command "LINE" pt p11 "")                                                             
                                                                                (command "LINE" pt p12 "")                                                             
                                                                        )                                               
                                                                        (setq s1 (entlast))                                               
                                                                        (if (< (distance pt p21) (distance pt p22))                                                       
                                                                                (command "LINE" pt p21 "")                                                             
                                                                                (command "LINE" pt p22 "")                                                             
                                                                        )                                               
                                                                        (setq s2 (entlast))                                               
                                                                        (setq ss (ssadd))                                               
                                                                        (ssadd s1 ss)                                               
                                                                        (ssadd s2 ss)                                               
                                                                        (command "_.scale" ss "" pt 0.35)                                               
                                                                )                                                               
                                                        )       
                                                        (setq e1 nil e2 nil MSG T)                                               
                                                )
                                               
                                        )
                                                       
                                )                                                                                                                               
               
       
        (PRINC)
       
)
页: [1] 2
查看完整版本: entsel如何按空格或回车退出while循环