求各位大神，把这个程序改成循环的

664571221

张大锤 发表于 2018-7-13 08:48
(repeat 10000 (c:命令)),循环执行10000次

是的啊，我的意思是要不右键就对出程序，等于执行一次了再自动继续执行

664571221

Andyhon 发表于 2018-7-13 08:43
;;(setq n (sslength (setq s (ssget '((8 . "中心线")(0 . "ARC,LINE,*POLYLINE"))))))
(while (setq s  ...

大神 图纸和原来的程序已经上传，我按你的改了，好像不起作用 ，能不能帮我看下，谢谢大神

bluefcc1

可以循環執行(滑鼠右鍵>繼續,滑鼠左鍵>結束)
(defun Dk:PtRelateLine (Pt1 Pt2 Pt3 / Dis12 Dis13 Dis23)
    (cond ((= (rtos (setq Dis12 (distance Pt1 Pt2)) 2 5) "0.00000") 1)
          ((= (rtos (setq Dis13 (distance Pt1 Pt3)) 2 5) "0.00000") 2)
          ((= (rtos (+ Dis12 Dis13) 2 5) (rtos (setq Dis23 (distance Pt2 Pt3)) 2 5)) 4)
          ((= (rtos (+ Dis13 Dis23) 2 5) (rtos Dis12 2 5)) 8)
          ((= (rtos (+ Dis12 Dis23) 2 5) (rtos Dis13 2 5)) 16)
          (t 32)))
(defun C:E (/ n s j dxf_a a10 a11 k data1 data2 dxf_b b10 b11 insect d1 d2 index)  
  (setq n (sslength (setq s (ssget '((0 . "ARC,LINE,*POLYLINE")(8 . "中心線"))))))
  (setq j -1)
  (while (< (setq j (1+ j)) n)   
    (setq dxf_a (entget (ssname s j)))
    (setq a10 (cdr (assoc 10 dxf_a)))
    (setq a11 (cdr (assoc 11 dxf_a)))
    (setq k -1  data1 (list) data2 (list))
    (while (< (setq k (1+ k)) n)      
      (setq dxf_b (entget (ssname s k)))
      (if (/= (cdr (assoc 5 dxf_a)) (cdr (assoc 5 dxf_b)))
        (progn
          (setq b10 (cdr (assoc 10 dxf_b)) b11 (cdr (assoc 11 dxf_b)))
          (if (null (inters a10 a11 b10 b11))
            (progn
              (if (setq insect (inters a10 a11 b10 b11 nil))
                (progn                  
                  (if (/= 0 (logand 7 (Dk:PtRelateLine insect b10 b11)))
                    (progn                     
                      (cond ((> (setq d1 (distance insect a10))(setq d2 (distance insect a11)))
                             (setq data1 (append data1 (list (list d2 insect 11)))))
                            ((setq data2 (append data2 (list (list d1 insect 10))))))
                      ))
                  )) ;end if (setq insect (inters a10 a11 b10 b11 nil))
              )) ;end if (null (inters a10 a11 b10 b11))
          )) ;end if (/= (cdr (assoc 5 dxf_a)) (cdr (assoc 5 dxf_b)))
      ) ;end while
   
    (if (> (length data1) 0)
      (progn
        (setq data1 (vl-sort data1 '(lambda (X Y) (< (car X)(car Y)))))
        (setq index (last (car data1)))        
        (entmod (setq dxf_a (subst (cons index (cadr (car data1)))(assoc index dxf_a) dxf_a)))
        )
      )
   
    (if (> (length data2) 0)
      (progn
        (setq data2 (vl-sort data2 '(lambda (X Y) (< (car X)(car Y)))))
        (setq index (last (car data2)))        
        (entmod (subst (cons index (cadr (car data2)))(assoc index dxf_a) dxf_a))
        )
      )
    ) ;end while
    (princ "\n<結束>左鍵> / <繼續>右鍵> :")
    (setq TEST t)
           (while TEST
         (setq TMP (grread t 7 1))
         (cond
                 ((= (car TMP) 3)
                      (setq TEST NIL)
          )
                 ((= (car TMP) 25)
                      (C:E)
                      (setq TEST NIL)
                 )
                 );end cond
           )
  (princ)
)

664571221

bluefcc1 发表于 2018-7-14 08:22
可以循環執行(滑鼠右鍵>繼續,滑鼠左鍵>結束)
(defun DktRelateLine (Pt1 Pt2 Pt3 / Dis12 Dis13 Dis23)
...

谢谢老大，这个功能很不错

664571221

bluefcc1 发表于 2018-7-14 08:22
可以循環執行(滑鼠右鍵>繼續,滑鼠左鍵>結束)
(defun DktRelateLine (Pt1 Pt2 Pt3 / Dis12 Dis13 Dis23)
...

你好大神，能不能帮我看下这个程序如何改成循环
(defun c:FB( / msg osmode pp_start pp_end ss ss_2 ss_leng k short_pp_all ss_name ss_obj_name short_obj_pp short_pp_all pp_length i pp_1 pp_2)
        (setq olderr *error* *error* error)
        (setq osmode (getvar "osmode"))
        (setvar "osmode" 0)
        (setvar "cmdecho" 0)
        (vl-cmdf "_.undo" "be")
        (setq pp_start (getpoint "\n指点栏选起点"))
        (setq pp_end (getpoint pp_start "\n指定栏选终点"))
        (setq ss (ssget "f" (list pp_start pp_end) '((0 . "line,lwpolyline"))))
        (setq ss_2 (ssget "f" (list pp_start pp_end) '((0 . "lwpolyline"))))
        (if (/= ss_2 nil)(vl-cmdf "qaflags" 1 "_.explode" ss_2 "" "qaflags" 0))
        (setq ss (ssget "f" (list pp_start pp_end) '((0 . "line"))))
        (setq ss_leng (sslength ss))
        (setq k -1)
        (setq short_pp_all '())
        (repeat ss_leng
                (setq k (1+ k))       
                (setq ss_name (ssname ss k))
                (setq ss_obj_name (vlax-ename->vla-object ss_name))
                (setq short_obj_pp (list (vlax-curve-getclosestpointto ss_obj_name pp_start)))
                (setq short_pp_all (append short_obj_pp short_pp_all))
        )
        (setq pp_length (length short_pp_all))
        (setq i -1)
        (repeat (- pp_length 1)
                (setq i (1+ i))
                (setq pp_1 (nth i short_pp_all))
                (setq pp_2 (nth (+ i 1) short_pp_all))
                (vl-cmdf "dimaligned" pp_1 pp_2 (polar pp_1 (angle pp_1 pp_2) (/ (distance pp_1 pp_2) 2)))
        )
        (vl-cmdf "_.undo" "e")
        (setvar "osmode" osmode)
        (setvar "cmdecho" 1)
        (princ)

)

(defun error(msg)
        (setvar "osmode" osmode)
        (setvar "cmdecho" 1)
        (setq *error* olderr)
)

bluefcc1

664571221 发表于 2018-8-8 11:35
你好大神，能不能帮我看下这个程序如何改成循环
(defun c:FB( / msg osmode pp_start pp_end ss ss_2 ss ...

這程式功能是什麼?

bluefcc1

664571221 发表于 2018-8-8 11:35
你好大神，能不能帮我看下这个程序如何改成循环
(defun c:FB( / msg osmode pp_start pp_end ss ss_2 ss ...

(defun c:FB( / msg osmode pp_start pp_end ss ss_2 ss_leng k short_pp_all ss_name ss_obj_name short_obj_pp short_pp_all pp_length i pp_1 pp_2  test tmp)
        (setq olderr *error* *error* error)
        (setq osmode (getvar "osmode"))
        (setvar "osmode" 0)
        (setvar "cmdecho" 0)
        (vl-cmdf "_.undo" "be")
        (setq pp_start (getpoint "\n指點欄選起點"))
        (setq pp_end (getpoint pp_start "\n指定欄選終點"))
        (setq ss (ssget "f" (list pp_start pp_end) '((0 . "line,lwpolyline"))))
        (setq ss_2 (ssget "f" (list pp_start pp_end) '((0 . "lwpolyline"))))
        (if (/= ss_2 nil)(vl-cmdf "qaflags" 1 "_.explode" ss_2 "" "qaflags" 0))
        (setq ss (ssget "f" (list pp_start pp_end) '((0 . "line"))))
        (setq ss_leng (sslength ss))
        (setq k -1)
        (setq short_pp_all '())
        (repeat ss_leng
                (setq k (1+ k))        
                (setq ss_name (ssname ss k))
                (setq ss_obj_name (vlax-ename->vla-object ss_name))
                (setq short_obj_pp (list (vlax-curve-getclosestpointto ss_obj_name pp_start)))
                (setq short_pp_all (append short_obj_pp short_pp_all))
        )
        (setq pp_length (length short_pp_all))
        (setq i -1)
        (repeat (- pp_length 1)
                (setq i (1+ i))
                (setq pp_1 (nth i short_pp_all))
                (setq pp_2 (nth (+ i 1) short_pp_all))
                (vl-cmdf "dimaligned" pp_1 pp_2 (polar pp_1 (angle pp_1 pp_2) (/ (distance pp_1 pp_2) 2)))
        )
         (princ "\n<結束>左鍵> / <繼續>右鍵> :")
         (setq TEST t)
         (while TEST
              (setq TMP (grread t 7 1))
               (cond
                  ((= (car TMP) 3)
                       (setq TEST NIL)
                  )
                  ((= (car TMP) 25)
                       (c:fb)
                  )
              );end cond
         )
        (vl-cmdf "_.undo" "e")
        (setvar "osmode" osmode)
        (setvar "cmdecho" 1)
        (princ)
)
(defun error(msg)
        (setvar "osmode" osmode)
        (setvar "cmdecho" 1)
        (setq *error* olderr)
)

season_88

谢谢大师分享