划线 剪断多段线

孙玉坤

有哪位大神 能帮忙给修改一下  这个代码   就是现在这个代码只能把与划线相交的线段给断开  ，不能自动连接和闭合 ，能修改修剪断开后，得到的图形自动连接和闭合吗， 如下图

孙玉坤

;;;=======================[ BreakAtObject.lsp ]=======================  
;;; Author: Charles Alan Butler & Will DeLoach  
;;; Version:  1.5 Feb. 22, 2006  
;;; Purpose: Break lines, plines, splines, ellipse, circles & arcs  
;;;          with a crossing object or user line, not blocks  
;;; Sub_Routines: ssget->vla-list  
;;;               list->3pair  
;;; Requirements:  
;;; Returns:   
;;;==============================================================  

;;  Ignores objects on locked layers  
;;  This code is still under deveopment  


(defun c:Bo1 (/ ss brk_obj ents ssobjs cmd obj_erase  
                      onlockedlayer ssget->vla-list list->3pair)  
  (vl-load-com)  

  (defun onlockedlayer (ename / entlst)  
    (setq entlst (tblsearch "LAYER" (cdr (assoc 8 (entget ename)))))  
    (= 4 (logand 4 (cdr (assoc 70 entlst))))  
  )  
  (defun ssget->vla-list (ss ent / i ename lst)  
    (setq i -1)  
    (while (setq ename (ssname ss (setq i (1+ i))))  
      ;; check for locked layer, do not use if on locked layer  
      (if (and (not (onlockedlayer ename))  
               (not (equal ename ent))) ; exclude break object  
         (setq lst (cons (vlax-ename->vla-object ename) lst))  
      )  
    )  
    lst  
  )  
   
  (defun list->3pair (old / new)  
    (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)  
                 old (cdddr old)))  
    (reverse new)  
  )  

  (setq cmd (getvar "CMDECHO"))  
  (setvar "CMDECHO" 0)  
  (command ".undo" "begin")  


  ;;  get break line or object  
  (if (and  
        (progn  
          (prompt "\nSelect objects to break: ")  
          (setq ss (ssget' ((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))  
        )  
        (setq p1 (getpoint "\nDraw Breaking line or press ENTER to select: "))  
        (setq p2 (getpoint p1 "\nPick end of line."))  
      )  
    (progn ; got points for a line  
      (vl-cmdf "._line" p1 p2 "")  
      (setq ent       (entlast)  
            obj_erase t ; remove it when done  
      )  
    )  
    (if ss  
      (while  
        (progn  
          (setq ent (car (entsel "\nSelect break entity, No blocks.")))  
          (cond  
            ((null ent)  nil)  
            ((member (cdr (assoc 0 (entget ent)))  
                    ' ("LINE" "ARC" "SPLINE" "LWPOLYLINE" "POLYLINE" "CIRCLE" "ELLIPSE"))  
             nil)  
            (t (prompt "\n*** Wrong object type, Try again.")  
             t)  
            )  
          )  
        )  
     )  
   )  

   
  (if (and ss ent  
           (setq ssobjs (ssget->vla-list ss ent)))  
    (progn  
      (setq brk_obj (vlax-ename->vla-object ent))  
      (mapcar  
       ' (lambda (obj2Break / iplist brkobjlst lastent) ; loop through list of objects to be broken  
           ; get list of intersect points  
           (setq iplist (vl-catch-all-apply' vlax-safearray->list  
                          (list (vlax-variant-value  
                             (vla-intersectwith brk_obj obj2Break acextendnone))))  
           )  
           (setq brkobjlst (cons obj2Break brkobjlst)) ; collect the original object to be broken  
           (if (not (vl-catch-all-error-p iplist));  error if no intersection  
             (mapcar  ; loop through  intersect points  
              ' (lambda (pt / cen elst maxparam minparam p1 p2 p1param p2param)  
                  ;;  get last entity created via break in case multiple breaks  
                     (if (and lastent (not (equal lastent (vlax-vla-object->ename brk_obj)))) ; ignore the break object  
                       (progn ; new object created via break, put in list  
                         (setq brkobjlst (cons (vlax-ename->vla-object (entlast)) brkobjlst))  
                         ;;  if pt not on object x, switch objects  
                         (if (not (vlax-curve-getdistatpoint obj2Break pt))  
                           (foreach obj brkobjlst ; find the one that pt is on  
                             (if (vlax-curve-getdistatpoint obj pt)  
                                (setq obj2Break obj) ; switch objects  
                               )  
                             )  
                         )  
                       )  
                     )  

                 ;;  Handle any objects that can not be use with the Break Command  
                 ;;  using one point  
                 (cond  
                    ((and (= "AcDbSpline" (vla-get-objectname obj2Break)) ; only closed splines  
                          (vlax-curve-isClosed obj2Break)  
                          )  
                      (setq p1param  (vlax-curve-getparamatpoint obj2Break pt)  
                            p2param  (+ p1param 0.000001)  
                            p2       (vlax-curve-getPointAtParam obj2Break p2param)  
                      )  
                     (command "._break" (vlax-vla-object->ename obj2Break) "non" (trans pt 0 1) "non" (trans p2 0 1))  
                    )  
                    ((= "AcDbCircle" (vla-get-objectname obj2Break)) ; break the circle  
                      (setq p1param  (vlax-curve-getparamatpoint obj2Break pt)  
                            p2param  (+ p1param 0.000001)  
                            p2       (vlax-curve-getPointAtParam obj2Break p2param)  
                      )  
                     (command "._break" (vlax-vla-object->ename obj2Break) "non" (trans pt 0 1) "non" (trans p2 0 1))  
                     (setq en (entlast))  
                    )  
                    ((and (= "AcDbEllipse" (vla-get-objectname obj2Break)) ; only closed ellipse  
                          (vlax-curve-isClosed obj2Break))  
                      ;;  Break the ellipse, code borrowed from Joe Burke  6/6/2005  
                      (setq p1param  (vlax-curve-getparamatpoint obj2Break pt)  
                            p2param  (+ p1param 0.000001) ;(vlax-curve-getparamatpoint obj p2)  
                            minparam (min p1param p2param)  
                            maxparam (max p1param p2param)  
                      )  
                      (vlax-put obj2Break' startparameter maxparam)  
                      (vlax-put obj2Break' endparameter (+ minparam (* pi 2)))  
                    )  
                    ;;==================================  
                    ;;   Objects that can be broken      
                    ;;==================================  
                    (t  
                     ;;(command "point"  "non" (trans pt 0 1))  
                     ;;(command "._break" (vlax-vla-object->ename obj2Break) "non" (trans pt 0 1) "@")  
                     (command "._break" (vlax-vla-object->ename obj2Break) "non" (trans pt 0 1) "non" (trans pt 0 1))  
                     ;;  could not get vl-cmdf "._break" to behave  
                     (setq lastent (entlast))  
                    )  
                  )  

                )
               (list->3pair iplist)  
             )  
           )  
         )  
        ssobjs  
      )  
      ;; remove the break line, if current layer is not locked  
      (if obj_erase  
         (vl-catch-all-apply' vla-delete (list brk_obj))  
      )  
    )  
  )  
  (setvar "CMDECHO" cmd)  
  (not (command ".undo" "end"))  
  (princ)  
)

孙玉坤

孙玉坤 发表于 2019-7-23 23:13
;;;=======================[ BreakAtObject.lsp ]=======================  
;;; Author: Charles Alan B ...

怎么没有大师来帮忙呢

999999

路过，顶起来