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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [求助]求教求交点函数怎么写。
123下一页
返回列表 发新帖
楼主: xstlf

[求助]求教求交点函数怎么写。

  [复制链接]
meflying
发表于 2004-12-20 08:28:00 | 显示全部楼层
xstlf发表于2004-12-19 22:14:00现在我是一碰到要求直线交点的函数就死蟹一只了。

已经有3次叫你看置顶的帖子了，看来你是情愿做一只死蟹也不愿意看置顶的求交点的帖子了！！！
回复 支持 反对

使用道具 举报

xstlf
 楼主| 发表于 2004-12-20 09:06:00 | 显示全部楼层
我早看了呀，看得眼都花了，这么长的函数就为了求二曲线的交线。若我要求的是所有选择集的交点又想把他们都在交点打断，那不是函数也太肥了吗？变成了大胖子了，有没有更简单一点的呀。meflying老师，不要再说我呀，我怕怕呀，呵呵。算我多嘴。我只是想找出所有的交点，把曲线在交点处打断就行了呀。
回复 支持 反对

使用道具 举报

winabcd
发表于 2004-12-20 09:26:00 | 显示全部楼层
我曾看到过求两实体交点的程序，你在论埮中找找，


那个程序不但可以求两直线交点，多义线的多个交点都可以求
回复 支持 反对

使用道具 举报

meflying
发表于 2004-12-20 12:38:00 | 显示全部楼层
仅限于LINE
  2. (vl-load-com)
  3. (defun c:breakall( / ss n i j ents ent1 ent2 pts)
  4.    (setq ss (ssget '((0 . "line"))))
  5.    (setq n (sslength ss))
  6.    (setq i 0)
  7.    (while (< i n)
  8.        (setq ents (append ents (list (list (ssname ss i)))))
  9.        (setq i (1+ i))
  10.    )
  11.    (setq i 0)
  12.    (while (< i n)
  13.        (setq j (1+ i))
  14.        (setq ent1 (ssname ss i))
  15.        (while (< j n)
  16.            (setq ent2 (ssname ss j))
  17.            (setq pts (getinterpoint ent1 ent2))
  18.            (if pts
  19.   (progn
  20.      (setq ents (subst (append (assoc ent1 ents) pts) (assoc ent1 ents) ents))
  21.      (setq ents (subst (append (assoc ent2 ents) pts) (assoc ent2 ents) ents))
  22.   )
  23.            )
  24.            (setq j (1+ j))
  25.        )
  26.        (setq i (1+ i))
  27.    )
  28.    (mapcar 'breaks ents)
  29.    (princ ents)
  30. )
  31. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
  32.    (setq ax_ent_1 (vlax-ename->vla-object ent1)
  33.                ax_ent_2 (vlax-ename->vla-object ent2)
  34.    )
  35.    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
  36.    (setq intpoints (vlax-variant-value intpoints))
  37.    (setq i 0)
  38.    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
  39.        (repeat (/ (+ 1
  40.                            (- (vlax-safearray-get-u-bound intpoints 1)
  41.                                  (vlax-safearray-get-l-bound intpoints 1)
  42.                            )
  43.                      )
  44.                      3
  45.                )
  46.            (setq points (append points (list (list
  47.                (vlax-safearray-get-element intpoints i)
  48.                (vlax-safearray-get-element intpoints (+ i 1))
  49.                (vlax-safearray-get-element intpoints (+ i 2))
  50.            )))
  51.            )
  52.            (setq i (+ 3 i))
  53.        )
  54.    )
  55.    points
  56. )
  57. (defun breaks(lst / n i sname sinf ptstart ptend pts)
  58.    (setq sname (car lst))
  59.    (setq sinf (entget sname))
  60.    (setq ptstart (cdr (assoc 10 sinf)))
  61.    (setq ptend (cdr (assoc 11 sinf)))
  62.    (setq pts (cdr lst))
  63.    (setq pts (vl-sort (append (list ptstart ptend) pts) '(lambda(e1 e2) (> (car e1) (car e2)))))
  64.    (setq n (length lst))
  65.    (setq i 0)
  66.    (mapcar 'command (append (list "_.line") pts (list "")))
  67.    (entdel sname)
  68. )
回复 支持 反对

使用道具 举报

xstlf
 楼主| 发表于 2004-12-20 14:42:00 | 显示全部楼层
本帖最后由 作者 于 2004-12-20 21:04:41 编辑

谢谢 meflying 老师，这下又可以让我这LISP新手研究上一天半天了。一朵鲜花，略表敬意。上面的那个我试过了，可能还是有点小问题。有些线打不断的，但总体来说很好。就是发现上面的二条直线相交只打断了一条，其中一条没被打断。
回复 支持 反对

使用道具 举报

xstlf
 楼主| 发表于 2004-12-21 19:36:00 | 显示全部楼层
(setq ptstart (cdr (assoc 10 sinf)))
(setq ptend (cdr (assoc 11 sinf))) 上面的breaks子程序里面的上面二句。其中。10和11分别指什么呀。哎。我找来找去找不到相关的资料。望这儿所有的老师们能不厌其烦帮我解答一下。我想我现在LISP可以已经快幼儿园毕业了，就让我早点升小学吧。呵呵。
回复 支持 反对

使用道具 举报

meflying
发表于 2004-12-22 08:18:00 | 显示全部楼层
参看帮助文件的DXF部分
回复 支持 反对

使用道具 举报

meflying
发表于 2004-12-22 08:27:00 | 显示全部楼层
再试试
  2. (vl-load-com)
  3. (defun c:breakall( / ss n i j ents ent1 ent2 pts)
  4.    (setq ss (ssget '((0 . "line"))))
  5.    (setq n (sslength ss))
  6.    (setq i 0)
  7.    (while (< i n)
  8.        (setq ents (append ents (list (list (ssname ss i)))))
  9.        (setq i (1+ i))
  10.    )
  11.    (setq i 0)
  12.    (while (< i n)
  13.        (setq j (1+ i))
  14.        (setq ent1 (ssname ss i))
  15.        (while (< j n)
  16.            (setq ent2 (ssname ss j))
  17.            (setq pts (getinterpoint ent1 ent2))
  18.            (if pts
  19.   (progn
  20.      (setq ents (subst (append (assoc ent1 ents) pts) (assoc ent1 ents) ents))
  21.      (setq ents (subst (append (assoc ent2 ents) pts) (assoc ent2 ents) ents))
  22.   )
  23.            )
  24.            (setq j (1+ j))
  25.        )
  26.        (setq i (1+ i))
  27.    )
  28.    (mapcar 'breaks ents)
  29.    (princ)
  30. )
  31. (defun GetInterPoint (ent1 ent2 / ax_ent_1 ax_ent_2 intpoints points i)
  32.    (setq ax_ent_1 (vlax-ename->vla-object ent1)
  33.                ax_ent_2 (vlax-ename->vla-object ent2)
  34.    )
  35.    (setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
  36.    (setq intpoints (vlax-variant-value intpoints))
  37.    (setq i 0)
  38.    (if (> (vlax-safearray-get-u-bound intpoints 1) 0)
  39.        (repeat (/ (+ 1
  40.                            (- (vlax-safearray-get-u-bound intpoints 1)
  41.                                  (vlax-safearray-get-l-bound intpoints 1)
  42.                            )
  43.                      )
  44.                      3
  45.                )
  46.            (setq points (append points (list (list
  47.                (vlax-safearray-get-element intpoints i)
  48.                (vlax-safearray-get-element intpoints (+ i 1))
  49.                (vlax-safearray-get-element intpoints (+ i 2))
  50.            )))
  51.            )
  52.            (setq i (+ 3 i))
  53.        )
  54.    )
  55.    points
  56. )
  57. (defun breaks(lst / n i sname sinf ptstart ptend pts)
  58.    (setq sname (car lst))
  59.    (setq sinf (entget sname))
  60.    (setq ptstart (cdr (assoc 10 sinf)))
  61.    (setq ptend (cdr (assoc 11 sinf)))
  62.    (setq pts (cdr lst))
  63.    (setq pts (vl-sort (append (list ptstart ptend) pts) '(lambda(e1 e2) (> (car e1) (car e2)))))
  64.    (setq pts (vl-sort pts '(lambda(e1 e2) (> (cadr e1) (cadr e2)))))
  65.    (setq n (length lst))
  66.    (setq i 0)
  67.    (mapcar 'command (append (list "_.line") pts (list "")))
  68.    (entdel sname)
  69. )
回复 支持 反对

使用道具 举报

xstlf
 楼主| 发表于 2004-12-22 11:08:00 | 显示全部楼层
原来所有的组码都在DXF帮助文件里有的呀，谢谢meflying 老师。还有上面的那个改新后的，breakall可能把所有交点打断了，呵呵。再次谢谢。
回复 支持 反对

使用道具 举报

afeng0712
发表于 2004-12-29 19:45:00 | 显示全部楼层
用用这个(SETQ HZ                (VLA-INTERSECTWITH         HJ1 ZJ1         ACEXTENDNONE））即可！


需先将HJ1，ZJ1线条图元变成VLA对象！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-9-29 22:18 , Processed in 0.146729 second(s), 18 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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