社区 › Auto Lisp › 标记相交距离

souvik 发表于 2022-7-5 22:32:01

标记相交距离

大家好。我有两条长度相同的多段线。一条多段线包含任意距离的交点。我需要用相同的相交距离标记另一条多段线。。

marko_ribar 发表于 2022-7-5 22:51:17

 
“一条多段线包含一些交点”的确切含义是什么？你认为ab顶点。。。请澄清。。。

souvik 发表于 2022-7-5 22:56:18

请看附件
样品图纸

hanhphuc 发表于 2022-7-5 23:06:53

http://www.lee-mac.com/intersectionfunctions.html
HTH公司

marko_ribar 发表于 2022-7-5 23:21:34

试试这个：
 

(defun c:mark_intersections_of_1st_curve_on_2nd ( / unique g3 c1 c2 ss i ent p pl d dl pn pnl )

(vl-load-com)

(defun unique ( l ) (if l (cons (car l) (unique (vl-remove (car l) (cdr l))))))

(defun g3 ( l ) (if l (cons (list (car l) (cadr l) (caddr l)) (g3 (cdddr l)))))

(setq c1 (car (entsel "\nPick first curve that has intersections")))
(while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c1)))
   (prompt "\nPicked entity don't belong to curves... Try again...")
   (setq c1 (car (entsel "\nPick first curve that has intersections")))
)
(setq ss (ssget "_X"))
(setq c2 (car (entsel "\nPick second curve that should be marked with intersections of first curve")))
(while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c2)))
   (prompt "\nPicked entity don't belong to curves... Try again...")
   (setq c2 (car (entsel "\nPick second curve that should be marked with intersections of first curve")))
)
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
   (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list ent)))
   (ssdel ent ss)
   )
)
(ssdel c1 ss)
(ssdel c2 ss)
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
   (if (setq p (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object ent) acextendnone))
   (foreach p (g3 p)
       (setq pl (cons p pl))
   )
   )
)
(setq pl (unique pl))
(foreach p pl
   (setq d (vlax-curve-getdistatpoint c1 p))
   (setq dl (cons d dl))
)
(foreach d dl
   (setq pn (vlax-curve-getpointatdist c2 d))
   (setq pnl (cons pn pnl))
)
(foreach pn pnl
   (entmake (list '(0 . "POINT") (cons 10 pn)))
)
(if (not (member (vlax-curve-getstartpoint c2) pnl))
   (entmake (list '(0 . "POINT") (cons 10 (vlax-curve-getstartpoint c2))))
)
(if (not (member (vlax-curve-getendpoint c2) pnl))
   (entmake (list '(0 . "POINT") (cons 10 (vlax-curve-getendpoint c2))))
)
(princ)
)

(defun c:mi1st2nd nil (c:mark_intersections_of_1st_curve_on_2nd))

 
HTH，M.R。

souvik 发表于 2022-7-5 23:25:43

感谢您的程序，但我收到了以下错误：------
错误：功能错误：
vlax曲线getStartParam
 
我正在使用Autocad 2010。。。

marko_ribar 发表于 2022-7-5 23:39:22

上面写着你用的是2012年。。。你在2012年测试过代码吗。。。在我的A2008上网本上，它运行良好。。。目前我正在度假，我无法复制你的错误。。。注意，我包括了支持vlisp扩展的线路（vl load com），其中还有（vlax curve getstartparam）。。。当测试上面发布的代码时，是否有人有相同的错误？如果是，请回复。。。我只是不知道问题出在哪里。。。

查看完整版本: 标记相交距离