设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 如何让不交的线的端点自动相交
123下一页
返回列表 发新帖
查看: 4197|回复: 20

如何让不交的线的端点自动相交

  [复制链接]
citykunan
发表于 2004-2-2 14:04:00 | 显示全部楼层 |阅读模式
本帖最后由 作者 于 2004-2-2 16:51:11 编辑

我又遇到一个难题，就是如何检查一个网格之中没有相交的点。当你输入一个最大值时，让所有小于这个值的不交的线的端点和出头的端点自动相交。网格都是line。 谢谢。



本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下
回复

使用道具 举报

meflying
发表于 2004-2-2 18:53:00 | 显示全部楼层
  2.   (defun ModPt(ents ptDes ptSou / ents2)
  3.    (setq ents2 ents)
  4.    (setq pt1 (cdr (assoc 10 ents)))
  5.    (setq pt2 (cdr (assoc 11 ents)))
  6.    (if (equal pt1 ptSou 0.000000001)
  7.        (setq ents2 (subst (cons 10 ptDes) (assoc 10 ents2) ents2))
  8.        (setq ents2 (subst (cons 11 ptDes) (assoc 11 ents2) ents2))
  9.    )
  10.    (entmod ents2)
  11. )(defun main( / ss n ent ents ents2 pt11 pt12 pt21 pt22 ptInter dist2)
  12.    (setq m 0)
  13.    (setq l 0)
  14.    (setq ss (ssget '((0 . "LINE"))))
  15.    (setq n (sslength ss))
  16.    (setq i 0)
  17.    (if (not dist)
  18.        (setq dist (getint "\n输入距离:"))
  19.        (progn (setq dist2 (getint (strcat "\n输入距离<" (itoa dist) ">:")))
  20.            (if dist2
  21.   (setq dist dist2)
  22.            )
  23.        )
  24.    )
  25.    (repeat n
  26.        (setq ent (ssname ss i))
  27.        (setq ents (entget ent))
  28.        (setq pt11 (cdr (assoc 10 ents)))
  29.        (setq pt12 (cdr (assoc 11 ents)))
  30.        (setq j 0)
  31.        (repeat n
  32.            (if (/= i j)
  33.   (progn
  34.      (setq ent (ssname ss j))
  35.      (setq ents2 (entget ent))
  36.      (setq pt21 (cdr (assoc 10 ents2)))
  37.      (setq pt22 (cdr (assoc 11 ents2)))
  38.      (setq ptInter (inters pt11 pt12 pt21 pt22 nil))
  39.      (cond
  40.          ((and ptInter (< (distance pt11 ptInter) dist) (> (distance pt11 ptInter) 0.0000001))
  41.            (setq ents (modpt ents ptInter pt11)))
  42.          ((and ptInter (< (distance pt12 ptInter) dist) (> (distance pt12 ptInter) 0.0000001))
  43.            (setq ents (modpt ents ptInter pt12)))
  44.      )
  45.   )
  46.            )
  47.            (setq j (1+ j))
  48.        )
  49.        (setq i (1+ i))
  50.    )
  51. )
回复 支持 反对

使用道具 举报

citykunan
 楼主| 发表于 2004-2-3 09:19:00 | 显示全部楼层
飞版主真不愧为Lisp高手，这么难的程序也能编好。


程序的思路实在太巧妙了，谢谢飞版主。
回复 支持 反对

使用道具 举报

meflying
发表于 2004-2-3 10:25:00 | 显示全部楼层
思路似乎还比较过得去，不过方法我自己还是不太满意，主要是循环次数太多了，总共要循环n×n次（n为直线条数），这样如果要处理的直线太多就会很慢
回复 支持 反对

使用道具 举报

citykunan
 楼主| 发表于 2004-2-3 11:00:00 | 显示全部楼层
飞版主我发现了一个怪问题，在局部用这个程序每问题，但如果图形很大zoom-extend后，用这个程序会有很多线丢失，我仔细看了程序，也找出原因。速度还挺快。

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

meflying
发表于 2004-2-3 14:22:00 | 显示全部楼层
修正
  2. (defun ModPt(ents ptDes ptSou / ents2 pt1 pt2)
  3.    (setq ents2 ents)
  4.    (setq pt1 (cdr (assoc 10 ents)))
  5.    (setq pt2 (cdr (assoc 11 ents)))
  6.    (if (equal pt1 ptSou 0.000000001)
  7.        (progn
  8.            (setq ents2 (subst (cons 10 ptDes) (assoc 10 ents2) ents2))
  9.            (setq pt11 ptDes)
  10.        )
  11.        (progn
  12.            (setq ents2 (subst (cons 11 ptDes) (assoc 11 ents2) ents2))
  13.            (setq pt12 ptDes)
  14.        )
  15.    )
  16.    (entmod ents2)
  17. )(defun main( / ss n ent ents ents2 pt11 pt12 pt21 pt22 ptInter dist2)
  18.    (setq m 0)
  19.    (setq l 0)
  20.    (setq ss (ssget '((0 . "LINE"))))
  21.    (setq n (sslength ss))
  22.    (setq i 0)
  23.    (if (not dist)
  24.        (setq dist (getint "\n输入距离:"))
  25.        (progn (setq dist2 (getint (strcat "\n输入距离<" (itoa dist) ">:")))
  26.            (if dist2
  27.   (setq dist dist2)
  28.            )
  29.        )
  30.    )
  31.    (repeat n
  32.        (setq ent (ssname ss i))
  33.        (setq ents (entget ent))
  34.        (setq pt11 (cdr (assoc 10 ents)))
  35.        (setq pt12 (cdr (assoc 11 ents)))
  36.        (setq j 0)
  37.        (repeat n
  38.            (if (/= i j)
  39.   (progn
  40.      (setq ent (ssname ss j))
  41.      (setq ents2 (entget ent))
  42.      (setq pt21 (cdr (assoc 10 ents2)))
  43.      (setq pt22 (cdr (assoc 11 ents2)))
  44.      (setq ptInter (inters pt11 pt12 pt21 pt22 nil))
  45.      (cond
  46.          ((and ptInter (< (distance pt11 ptInter) dist) (> (distance pt11 ptInter) 0.0000001))
  47.            (setq ents (modpt ents ptInter pt11)))
  48.          ((and ptInter (< (distance pt12 ptInter) dist) (> (distance pt12 ptInter) 0.0000001))
  49.            (setq ents (modpt ents ptInter pt12)))
  50.      )
  51.   )
  52.            )
  53.            (setq j (1+ j))
  54.        )
  55.        (setq i (1+ i))
  56.    )
  57. )
回复 支持 反对

使用道具 举报

citykunan
 楼主| 发表于 2004-2-3 15:23:00 | 显示全部楼层
飞版主，好像还有一点问题，当距离输入80运行后，原来不出头的线，现在出头了。不知如何修改为好？


       

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

citykunan
 楼主| 发表于 2004-2-6 09:00:00 | 显示全部楼层
我这两天都在试这个程序，我发现在一块封闭的网格运行没什么问题，但多复制几个网格到不同的地方就会出现问题，真烦人啊。不知哪位大侠可以帮忙解决一下。


在下不胜感激。谢谢。


       

回复 支持 反对

使用道具 举报

meflying
发表于 2004-2-6 09:05:00 | 显示全部楼层
问题我找出来了，不过这个如还按原来的方法，判断条件就变得很复杂，也没有想出好办法，等我再想想。
回复 支持 反对

使用道具 举报

龙龙仔
发表于 2004-2-6 12:28:00 | 显示全部楼层

;;BY 龍龍仔(LUCAS)

;;這是別一種方法,但效果也不好,必需放大並小圍範執行,距離也要提供很精確

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

123下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-27 15:53 , Processed in 0.210986 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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