与方法问题相交

jbreard · 发表于 2022-7-5 17:58:36

你好

我在使用以下代码查找两条LWpolyline之间的交点时遇到问题：

(vl-load-com)
(defun c:intersect (/ curve1-ename curve2-ename curve1-obj curve2-obj c d)
(setq curve1-ename (car (entsel "\nSelect first curve")))
(setq curve2-ename (car (entsel "\nSelect second curve")))
(setq curve1-obj (vlax-ename->vla-object curve1-ename))
(setq curve2-obj (vlax-ename->vla-object curve2-ename))
 (setq c
        (vlax-variant-value
          (vlax-invoke-method
        curve1-obj
        "IntersectWith"
        curve2-obj
        acExtendnone
       )
        )
     )
(setq d
   (vl-catch-all-apply
          'vlax-safearray->list
          (list c)
        )
 )
 
 (entmakex (list (cons 0 "POINT")
         (cons 8 "00-CONSTR7")
                 (cons 10 (list (car d) (cadr d)))
        )
 )
(princ)
)

我所有的LWpolyline的高程都为0，所以这不是问题所在。在所附文件中，您将看到蓝色修订云中的小多段线，该多段线显然与图层“AXE-REF-PK”上的白色多段线不相交（但它们显然相交；错误类型为：“ActiveX服务器返回了一个错误：生成了无效索引”）。这条多段线有1900多个顶点，因此可能存在尺寸限制。我在上面画了完全相同的情况，但有一半顶点的多边形。这一次，程序每次都会找到一个交点。使用intersectwith方法确实有很多东西我没有得到

有没有人遇到过类似的问题？

当做

雅克

与方法问题相交。图纸

Lee Mac · 发表于 2022-7-5 18:27:25

如果对象远离原点，则intersectwith方法可能是易变的-请尝试以下代码：

copy

(defun c:inters ( / lst ob1 ob2 vec )
   (if (and (setq ob1 (car (entsel "\nSelect 1st curve: ")))
            (setq ob2 (car (entsel "\nSelect 2nd curve: ")))
            (setq ob1 (vlax-ename->vla-object ob1))
            (setq ob2 (vlax-ename->vla-object ob2))
       )
       (if (or (setq lst (group3 (vlax-invoke ob1 'intersectwith ob2 acextendnone)))
               (   (lambda ( vec / ob3 ob4 )
                       (vla-move (setq ob3 (vla-copy ob1)) (vlax-3D-point vec) (vlax-3D-point 0 0))
                       (vla-move (setq ob4 (vla-copy ob2)) (vlax-3D-point vec) (vlax-3D-point 0 0))
                       (setq lst (group3 (vlax-invoke ob3 'intersectwith ob4 acextendnone))
                             lst (mapcar '(lambda ( x ) (mapcar '+ x vec)) lst)
                       )
                       (vla-delete ob3)
                       (vla-delete ob4)
                       lst
                   )
                   (vlax-curve-getstartpoint ob1)
               )
           )
           (foreach pnt lst (entmake (list '(0 . "POINT") '(8 . "00-CONSTR7") (cons 10 pnt))))
           (princ "\nNo intersection detected.")
       )
   )
   (princ)
)
(defun group3 ( lst / rtn )
   (repeat (/ (length lst) 3)
       (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
             lst (cdddr lst)
       )
   )
   (reverse rtn)
)
(vl-load-com) (princ)

此外，我建议不要将intersect定义为自定义命令，因为这已经是一个内置的AutoCAD命令。

jbreard · 发表于 2022-7-5 18:35:26

非常感谢李·麦克！工作起来很有魅力。我将记住，AutoCAD可能在典型地理坐标值方面存在问题。

至于intersect内置命令，我并没有试图模仿它。实际上，我需要能够在一个更大的lisp程序中找到两条多段线之间的交点，您的方法可以完美地完成这项工作。我设法看到了像弗拉·莫夫这样的新闻命令！

再次感谢并致以最良好的问候，

雅克

Lee Mac · 发表于 2022-7-5 18:55:45

不客气我很高兴该功能现在运行良好。

我知道您没有尝试模拟内置的AutoCAD命令，但应避免将内置命令的名称用作AutoLISP自定义命令。

jbreard · 发表于 2022-7-5 19:07:18

啊，好的。我现在明白你评论的真正含义了。我以后不会做了！再次感谢。

雅克

[编程交流] 与方法问题相交

发表回复

精选推荐