垂直lin的交点
你好，如何计算交点（i1，i2，i3，…），包括一些垂直线和多段线，如下图所示：
第1i1、2i2、3i3行不存在。
; j = 1 to 3 ...
i = (mapcar '+ '(0 100) ))
有什么想法吗？ 这将为您指明正确的方向：相交函数 这只适用于线路。。
(defun c:Test (/ _Ang s e sad ss i sn ent)
(defun _Ang (e) (angle (cdr (assoc 10 e)) (cdr (assoc 11 e))))
(if (and (setq ss (ssget "_X" '((0 . "LINE"))))
(setq sad (ssadd)
s (car (entsel "\n Select polyline :"))
)
(eq (cdr (assoc 0 (setq e (entget s)))) "LWPOLYLINE")
)
(repeat (setq i (sslength ss))
(setq ent (entget (setq sn (ssname ss (setq i (1- i))))))
(if (and (vlax-invoke (vlax-ename->vla-object s) 'IntersectWith (vlax-ename->vla-object sn) acExtendNone)
(or (equal (_Ang ent) (* pi 0.5) 1e-4) (equal (_Ang ent) (* pi 1.5) 1e-4))
)
(ssadd sn sad)
)
)
)
(sssetfirst nil sad)
(princ)
)
(defun c:WhereYouAt (/ e int pts mn mx dist tmpht i HtList p1 p2 p3p4)
(setq os (getvar 'osmode ))
(setvar 'osmode0)
(cond ((and (setq HtList nil
e (car (entsel "\nSelect Polyline:"))
)
(setq int (getdist "\nEnter Interval:"))
(Setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (ent) (= (car ent) 10)) (entget e))))
(progn (vla-GetBoundingBox (vlax-ename->vla-object e) 'mn 'mx)
(setq mn (vlax-safearray->list mn)
mx (vlax-safearray->list mx)
dist(- (car mx) (car mn))
tmpht (- (cadr mx) (cadr mn))
i int
)
)
(while (< i dist)
(setq p1 (polar mn 0 i)
p2 (polar p1 (/ pi 2.0) tmpht)
)
(setq p3p4 (vl-some '(lambda (x y)
(if (<= (car x) (car p1) (car y))
(list x y)
)
)
pts
(cdr pts)
)
)
(setq HtList (append HtList (list (inters p1 p2 (car p3p4) (cadr p3p4))))
i (+ i int)
)
(setq pts (member (car p3p4) pts))
)
(foreach p HtList (command "_point"p))
)
)
)(setvar 'osmode os)
(princ)
)
但在您的示例（Tharwat）中，我看到了一种更简单的方法：
(setq length-polylinelist(length polylinelist ) i 0)
(while (< i length-polylinelist )
(setq p1 (nth i polylinelist)i (1+ i) p2 (nth i polylinelist) )
(foreach p listpoints123...
(if (setq pc (inters p1 p2 p (mapcar '+ '(0 100) p ))
...
)
)
)
这是一种比最初想法更直接的方法。
但是可以给列表坐标而不是对象名称吗？ 查看此线程：
www.theswamp。组织/索引。php？主题=43630 谢谢李。
_polyinters函数运行速度比下面的代码快？
pc = (vlax-invoke (vlax-ename->vla-object poly) 'IntersectWith (vlax-ename->vla-object line)
acExtendOtherEntity)
(195.558 111.199 0.0)
_polyinters不会创建任何临时对象，因此应该执行得更快，但是该功能仅限于用于直段LWD多段线，如果测试多个线向量的相交，则可以优化该功能。 听起来你想创建个人资料
看看这是否有帮助，底线已经画出来了
在您的个人资料网格上
; polylinie = polyline object
; lisXYLin = list with coordinates of points 1, 2, 3, ...
(foreach p lisXYLin
(setq linie (vla-AddLine MSpace (vlax-3d-point p) (vlax-3d-point (mapcar '+ (list 0 100) p))) )
; vertical line
(if (setq pc (vlax-invoke polylinie 'IntersectWith linie acExtendBoth)) ;_ end of setq
(progn
(setq dad (distance p pc)) ;_ end of set
; ....... (entmake (list '(0 . "TEXT") ... )) ; write a text
)) ;_ end of if pc
(if (and linie (not (vlax-erased-p linie)) ) (vla-Delete linie) ) ;_ end of if and
) ; f
非常感谢你的帮助。我找到了我所寻找的最佳功能。
我已替换：
(defun c:profL(/ *error* adoc en en2 ent ent2 ept ni obj pts)
(vl-load-com)
(defun *error* (msg)
(vla-endundomark (vla-get-activedocument
(vlax-get-acad-object))
)
(cond ((or (not msg)
(member msg '("console break" "Function cancelled" "quit / exit abort"))
)
)
((princ (strcat "\nError: " msg)))
)
(princ)
)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)) )
(vla-startundomark adoc )
(if (and (setq ent (entsel "\nSelect top curve : "))
(setq ent2 (entsel "\nSelect bottom curve >>")))
(progn
(setq en (car ent)
pts (vl-remove-if 'not (mapcar '(lambda (x)(if (= 10 (car x))(trans (cdr x) 1 0)))(entget en)))
en2 (car ent2)
obj (vlax-ename->vla-object en2)
)
(foreach pt pts
(setq ept (vlax-curve-getclosestpointto obj pt))
(command "_line" "_non" pt "_non" ept "")
)
)
)
(*error* nil)
(princ)
)
使用：
(setq pc (vlax-invoke polylinie 'IntersectWith linie acExtendBoth))
并且不需要创建临时线。
谢谢fixo，你的例子很有帮助。
我尝试使用函数vlax curve getclosestpointto，但这不是我需要的。
是的，是一个轮廓，但并非所有线都指向顶点PLOLINEI段（#1）。 好的解决方案Costinbos
页:
[1]
2