(repeat 10000 (c:命令)),循环执行10000次
是的啊，我的意思是要不右键就对出程序，等于执行一次了再自动继续执行 Andyhon 发表于 2018-7-13 08:43
;;(setq n (sslength (setq s (ssget '((8 . "中心线")(0 . "ARC,LINE,*POLYLINE"))))))
(while (setq s...
大神 图纸和原来的程序已经上传，我按你的改了，好像不起作用 ，能不能帮我看下，谢谢大神 本帖最后由 bluefcc1 于 2018-7-14 08:28 编辑
可以循環執行(滑鼠右鍵>繼續,滑鼠左鍵>結束)
(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 -1data1 (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)
)
bluefcc1 发表于 2018-7-14 08:22
可以循環執行(滑鼠右鍵>繼續,滑鼠左鍵>結束)
(defun DktRelateLine (Pt1 Pt2 Pt3 / Dis12 Dis13 Dis23)
...
谢谢老大，这个功能很不错 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)
) 664571221 发表于 2018-8-8 11:35
你好大神，能不能帮我看下这个程序如何改成循环
(defun c:FB( / msg osmode pp_start pp_end ss ss_2 ss ...
這程式功能是什麼? 本帖最后由 bluefcc1 于 2018-8-8 22:23 编辑
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_2test 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)
)
谢谢大师分享
页:
1
[2]