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方法可能是易变的-请尝试以下代码:
(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

啊,好的。我现在明白你评论的真正含义了。我以后不会做了!再次感谢。
 
雅克
页: [1]
查看完整版本: 与方法问题相交