多段线修剪问题并得到线与多段线的交点表

zhuizhu

多段线修剪问题
并得到直线与多段线的交点表

st788796

好像api有一个函数就办了

ysq101

哪个函数呢?

cable2004

(defun c:tt (/ a b boxs ed ints ss sss x y)
  (vl-load-com)
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if ss
    (foreach a (vl-remove-if 'listp (mapcar
                                      'cadr
                                      (ssnamex ss)
                                    )
               )
      (setq boxs (m-objbox (vlax-ename->vla-object a)))
      (setq sss (ssget "_C" (car boxs) (last boxs)))
      (if sss
        (foreach b (vl-remove-if 'listp (mapcar
                                          'cadr
                                          (ssnamex sss)
                                        )
                   )
          (setq ed (entget b)
                ints nil
          )
          (if (= "LINE" (cdr (assoc 0 ed)))
            (if (setq ints (lm:intersections (vlax-ename->vla-object a)
                                             (vlax-ename->vla-object b) acextendnone
                           )
                )
              (progn
                (mapcar' (lambda (x y)
                           (setq ed (subst
                                      (cons x y)
                                      (assoc x ed)
                                      ed
                                    )
                           )
                         ) (list 10 11) ints
                )
                (entmod ed)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)
(defun lm:intersections (obj1 obj2 mode / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length l) 3)
    (setq r (cons (list (car l) (cadr l) (caddr l)) r)
          l (cdddr l)
    )
  )
  (reverse r)
)
(defun m-objbox (obj / minp maxp)
  (vla-getboundingbox obj 'minp 'maxp)
  (mapcar
    'vlax-safearray->list
    (list minp maxp)
  )
)

炫翔

cable2004 发表于 2014-2-16 23:14
(defun c:tt (/ a b boxs ed ints ss sss x y)
  (vl-load-com)
  (setq ss (ssget '((0 . "LWPOLYLINE") ...

我测试了下, 修剪上完全符合题意,
有个问题  当直线一头在外一头在内的情况,不能实现

zhuizhu

{:soso_e179:}谢谢提供思路,我自己再弄下

cable2004

(defun c:tt (/ a b boxs ed ints ss sss x y)
  (vl-load-com)
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if ss
    (foreach a (vl-remove-if 'listp (mapcar
                                      'cadr
                                      (ssnamex ss)
                                    )
               )
      (setq boxs (m-objbox (vlax-ename->vla-object a)))
      (setq sss (ssget "_C" (car boxs) (last boxs)))
      (if sss
        (foreach b (vl-remove-if 'listp (mapcar
                                          'cadr
                                          (ssnamex sss)
                                        )
                   )
          (setq ed (entget b)
                ints nil
          )
          (if (= "LINE" (cdr (assoc 0 ed)))
            (if (setq ints (lm:intersections (vlax-ename->vla-object a)
                                             (vlax-ename->vla-object b) acextendboth
                           )
                )
              (progn
                (mapcar' (lambda (x y)
                           (setq ed (subst
                                      (cons x y)
                                      (assoc x ed)
                                      ed
                                    )
                           )
                         ) (list 10 11) ints
                )
                (entmod ed)
              )
            )
          )
        )
      )
    )
  )
  (princ)
)