划线 剪断多段线
有哪位大神 能帮忙给修改一下这个代码 就是现在这个代码只能把与划线相交的线段给断开，不能自动连接和闭合 ，能修改修剪断开后，得到的图形自动连接和闭合吗， 如下图;;;=======================[ 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 throughintersect 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 Burke6/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 ...
怎么没有大师来帮忙呢 路过，顶起来
页:
[1]