社区 › Auto Lisp › Vla中与f相交的问题

gS7 发表于 2022-7-6 02:15:11

Vla中与f相交的问题

嘿，大哥，
我试图得到3dpolyline的交点，但每次都失败了
如果我选择lwpolylines或Line作为其返回的交点，问题是为什么3dpolylines的交点显示为零
 
示例代码：
(defun c:Test ()
(vl-load-com)
(setq ent1 (vlax-ename->vla-object (car (entsel "First entity: ")))
ent2 (vlax-ename->vla-object (car (entsel "Second entity: ")))
)
(vlax-safearray->list
   (vlax-variant-value
   (vla-IntersectWith ent1 ent2 acExtendnone)
   )
)
)
 
附件
3D多边形。图纸

GP_ 发表于 2022-7-6 02:20:20

多段线的高度不同，不相交

gS7 发表于 2022-7-6 02:23:44

总成_
你是说Z值？

gS7 发表于 2022-7-6 02:29:23

好的，我知道了，我必须选择Z值等于两条多段线相交的同一条多段线，
 
谢谢你提供的信息

gS7 发表于 2022-7-6 02:32:56

有什么方法可以得到3dpolyline和Lwpolyline之间的交点吗？
请帮忙

pBe 发表于 2022-7-6 02:37:03

使用inters函数设置Z值

Lee Mac 发表于 2022-7-6 02:39:54

 
我同意；下面是一个快速示例程序：

(defun c:test ( / e i j s1 s2 )
   (if
       (and
         (princ "\nSelect LWPolylines...")
         (setq s1 (ssget '((0 . "LWPOLYLINE"))))
         (princ "\nSelect 3D Polylines...")
         (setq s2 (ssget '((0 . "POLYLINE") (-4 . "&=") (70 . )))
       )
       (repeat (setq i (sslength s1))
         (setq e (ssname s1 (setq i (1- i))))
         (repeat (setq j (sslength s2))
               (foreach x (2D-poly-inters e (ssname s2 (setq j (1- j))))
                   (entmake (list '(0 . "CIRCLE") '(40 . 1.0) (cons 10 x)))
               )
         )
       )
   )
   (princ)
)

(defun 2D-poly-inters ( lwp 3dp / enx ls1 ls2 vtx )
   (setq ls1 (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget lwp)))
         3dp (entnext 3dp)
         enx (entget3dp)
   )
   (while (= "VERTEX" (cdr (assoc 0 enx)))
       (setq vtx (assoc 10 enx)
             ls2 (cons (list (cadr vtx) (caddr vtx)) ls2)
             3dp (entnext 3dp)
             enx (entget3dp)
       )
   )
   (if (= 1 (logand 1 (cdr (assoc 70 (entget (cdr (assoc 330 enx)))))))
       (setq ls2 (cons (last ls2) ls2))
   )
   (if (= 1 (logand 1 (cdr (assoc 70 (entget lwp)))))
       (setq ls1 (cons (last ls1) ls1))
   )
   (apply 'append
       (mapcar
         (function
               (lambda ( a b )
                   (vl-remove nil
                     (mapcar
                           (function
                               (lambda ( c d )
                                 (inters a b c d)
                               )
                           )
                           ls1 (cdr ls1)
                     )
                   )
               )
         )
         ls2 (cdr ls2)
       )
   )
)

GP_ 发表于 2022-7-6 02:46:23

第一条选定多段线上三维交点的版本。
 


(defun c:TesT ( / s1 s2 PP)
   (if
       (and
         (princ "\nSelect First 2D/3D Polyline")
         (setq s1 (ssget"_+.:S" '((0 . "*POLYLINE"))))
         (princ "\nSelect Second 2D/3D Polyline ")
         (setq s2 (ssget"_+.:S" '((0 . "*POLYLINE"))))
       )
       (progn
         (setq s1 (ssname s1 0))
         (setq s2 (ssname s2 0))
         (if (setq PP (3D_poly_inters s1 s2))
               (foreach x PP
                   (entmake (list '(0 . "CIRCLE") '(40 . 1.0) (cons 10 x)))
               )
         )            
       )
   )
)


(defun 3D_poly_inters (PL1 PL2 / vPL1 vPL2 zmin zmax p- p+ p_int)
   (setq vPL1 (pl_coord PL1))
   (setq vPL2 (pl_coord PL2))
   (mapcar
      '(lambda (x)
            (or zmin (setq zmin (last x)))
            (or zmax (setq zmax (+ zmin 0.01)))                     
            (if (< (last x) zmin) (setq zmin (last x)))
            (if (> (last x) zmax) (setq zmax (last x)))
       )
       vPL1
   )            
   (if (= 1 (logand 1 (cdr (assoc 70 (entget PL1)))))
       (setq vPL1 (cons (last vPL1) vPL1))
   )
   (if (= 1 (logand 1 (cdr (assoc 70 (entget PL2)))))
       (setq vPL2 (cons (last vPL2) vPL2))
   )
   (mapcar
       '(lambda ( a b )
            (mapcar
                '(lambda ( c d )
                     (if
                         (setq p
                              (inters
                                  (list (car a) (cadr a))
                                  (list (car b) (cadr b))
                                  (list (car c) (cadr c))
                                  (list (car d) (cadr d))
                              )
                         )
                         (progn
                           (setq p- (list (car p) (cadr p) zmin))
                           (setq p+ (list (car p) (cadr p) zmax))
                           (setq p (inters a b p- p+))
                           (setq p_int (cons p p_int))
                         )
                     )
               )
                vPL2 (cdr vPL2)                  
         )
       )
       vPL1 (cdr vPL1)
   )
   p_int
)


(defun pl_coord (# / p m)
   (setq p (if (vlax-curve-IsClosed #)
               (fix (vlax-curve-getEndParam #))
               (1+ (fix (vlax-curve-getEndParam #)))
         )
   )
   (while (/= 0 p)
       (setq m (cons (vlax-curve-getPointAtParam # (setq p (1- p))) m))
   )
)
(vl-load-com)

Lee Mac 发表于 2022-7-6 02:48:50

@总成，尖端：
(reverse (cdr (reverse vPL2)))
不需要，因为：
_$ (mapcar '+ '(1 2 3 4 5) '(2 3 4 5))
(3 5 7 9)

GP_ 发表于 2022-7-6 02:54:54

李，谢谢你的提示。

查看完整版本: Vla中与f相交的问题