暗夜贵族 发表于 2016-3-31 11:16:21

交叉管道自动打断，出错

(setq ss0 (ssget '((0 . "*LINE,ARC,ELLIPSE,CIRCLE"))))
(setq ss (ssget '((0 . "*LINE,ARC,ELLIPSE,CIRCLE"))))
(setq K -1)
(while   (setq E (ssname ss0(setq K (1+ K))))

      (setq i -1 o (vlax-ename->vla-object e))
      (while (setq a (ssname ss (setq i (1+ i))))
      (if (eq a e)
          nil
          (progn
            (setq ints (vlax-invoke o 'intersectwith (vlax-ename->vla-object a) acExtendNone))
            (while ints
               (setq pts(cons (list (car ints) (cadr ints) (caddr ints)) pts)
                     ints (cdddr ints)
               )
            )
          )
      )
      )
      (if pts
      (progn
         (setq dts (mapcar '(lambda (x) (vlax-curve-getdistatpoint o x)) pts))
         (setq dts (vl-sort dts '>))
         (mapcar '(lambda (x)
               (setq p1 (vlax-curve-getpointatdist e (- x 30))
                     p2 (vlax-curve-getpointatdist e (+ x 30)))
               (if (not p1)(setq p2 (vlax-curve-getstartpoint e)))
               (if (not p2)(setq p2 (vlax-curve-getendpoint e)))
               (command ".break" "_non" (list e p1) "_non" p2)
               )
            dts
         )
      )
      )


)

coverne 发表于 2017-12-21 10:57:58

请问有演示么
页: [1]
查看完整版本: 交叉管道自动打断，出错