明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 237|回复: 13

[提问] 求各位大神,把这个程序改成循环的

[复制链接]
发表于 2018-7-12 12:42 | 显示全部楼层 |阅读模式
本帖最后由 664571221 于 2018-7-13 09:06 编辑

===============================================
(defun DktRelateLine (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:EXT (/ n s j dxf_a a10 a11 k data1 data2 dxf_b b10 b11 insect d1 d2 index)  
  (setq n (sslength (setq s (ssget '((8 . "中心线")(0 . "ARC,LINE,*POLYLINE"))))))
  (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 (DktRelateLine 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))


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
发表于 2018-7-12 13:48 | 显示全部楼层
土方法,把lisp加载后,(repeat 10000 (c:命令)),循环执行10000次
发表于 2018-7-12 16:52 | 显示全部楼层
Linhay 发表于 2018-7-12 13:48
土方法,把lisp加载后,(repeat 10000 (c:命令)),循环执行10000次

你這個簡單 粗暴啊
发表于 2018-7-12 16:58 | 显示全部楼层
多按一下回车嘛
 楼主| 发表于 2018-7-12 22:09 | 显示全部楼层

可不可以帮忙改下
 楼主| 发表于 2018-7-12 22:10 | 显示全部楼层
张大锤 发表于 2018-7-12 16:52
你這個簡單 粗暴啊

牛逼啊 ,那比如执行了10次就想退出呢
 楼主| 发表于 2018-7-12 22:11 | 显示全部楼层
Linhay 发表于 2018-7-12 13:48
土方法,把lisp加载后,(repeat 10000 (c:命令)),循环执行10000次

能不能帮忙改下,我不是想执行10000次
发表于 2018-7-13 07:23 | 显示全部楼层
执行够了就按ecs退出
发表于 2018-7-13 08:43 | 显示全部楼层
;;(setq n (sslength (setq s (ssget '((8 . "中心线")(0 . "ARC,LINE,*POLYLINE"))))))
(while (setq s (ssget '((8 . "中心线")(0 . "ARC,LINE,*POLYLINE")))))
    (setq n (sslength s))
    (setq j -1)
    (while (< (setq j (1+ j)) n)   
      (setq dxf_a (entget (ssname s j)))
     ...
    ) ;_ end while
  ) ;_ end while   
发表于 2018-7-13 08:48 | 显示全部楼层
664571221 发表于 2018-7-12 22:10
牛逼啊 ,那比如执行了10次就想退出呢

(repeat 10000 (c:命令)),循环执行10000次


(repeat 10 (c:命令)),循环执行10次
但是这个 不解决你实际问题
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-7-19 17:39 , Processed in 0.250135 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表