改造一下打断于点

eachy · 发表于 2013-8-1 23:28:36

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:brp (/ s)
(if (setq s
(ssget
":S"
'((0 . "line,lwpolyline,arc,polyline,spline,trace,ray,xline")
)
)
)
(vl-catch-all-apply
'(lambda (/ el e)
(setq el (ssnamex s)
e (list (cadar el) (cadr (last (car el))))
)
(if (and (vlax-curve-isclosed (car e))
(vlax-curve-isPeriodic (car e))
)
(princ "\nCan not Break this Object!")
(progn
(command ".break" e "f")
(command pause)
(command "@")
)
)
)
)
(princ "\nNo Selected Break Object!")
)
(princ)
)
(princ "\nStart Command with Brp, eachy!")
(princ)

zyhandw · 发表于 2013-8-2 08:10:40

楼主最近放出不少好东西，顶！！

混沌初开 · 发表于 2013-11-22 23:29:37

加载后只能选择无法执行下一步！求指点！

混沌初开 · 发表于 2013-11-28 22:57:12

楼主在忙什么，怎么还不回复？

newer · 发表于 2013-11-28 23:03:50

混沌初开发表于 2013-11-28 22:57
楼主在忙什么，怎么还不回复？

你选择的是什么？选下封闭的曲线试试看。

aeo · 发表于 2013-11-29 22:17:56

(and (vlax-curve-isclosed (car e))
(vlax-curve-isPeriodic (car e))
)
-----------
是不是应该是or

eachy · 发表于 2013-11-29 22:55:53

aeo 发表于 2013-11-29 22:17
(and (vlax-curve-isclosed (car e))
(vlax-curve-isPeriodic (car e))
)

没有测试那么多, 仅测试了 line pline ，程序的本意是可以在打断与点的时候选线，然后可以任意指定点，可以使用捕捉

按 break 的提示“无法仅在一点打断闭合的周期性曲线。” 作的判断

xshrimp · 发表于 2013-11-29 23:11:48

用非command打断可以参考
BreakMethod v2.0.lsp

;; BreakMethod version 1.0
;; Joe Burke 6/6/2005
;;
;; Mlines, leaders, dimensions, regions, text objects,
;; blocks and solids can't be broken with the break command.
;; They are not supported.
;; Donuts are supported since they are lwplines.
;;
;; Change history
;; ---------------------
;; Version 1.1 6/8/2005
;; Changed TrueColor property to Color at BreakCircle function.
;;
;; Removed (trans p1 1 0) and (trans p2 1 0) at front end.
;; Better to let the calling function ensure points passed are WCS.
;; This avoids the possibility of WCS points wrongly transformed
;; when the calling function is operating in a UCS.
;;
;; 6/11/2005
;; At front end, moved type check to start to avoid error
;; when passing an ename and trying to get its layer object.
;;
;; 6/14/2005
;; Added fuzz factor to equal functions at various places.
;;
;; ---------------------
;; Version 1.2 6/16/2005
;; Added Tim Willey's suggestion. The function returns
;; T when the break operation is successful, otherwise nil.
;;
;; ---------------------
;; Version 1.3 7/8/2005
;; Changed how closed/open ellipse is determined.
;; Revised front end: the locked layer check is after setting
;; the space variable. So the return T or nil code at the end
;; doesn't toss an error (vla-object nil) when the object is
;; on a locked layer.
;; Revised return T or nil method at end to be an or statement
;; rather than condition.
;;
;; Thinking about going back to "cond" rather than "or" 7/11/2005.
;; So what's returned is a new object or a modified object.
;; Rather than just T when successful.
;;
;; Revised front end so the "and" function checks all setq's.
;;
;; ---------------------
;; Version 1.4 7/16/2005
;; Added check for arguments obj p1 and p2.
;; Moved return function inside "and" function. Revised calls
;; to sub-functions so they return T.
;;
;; Now returns a new object if one was created or a modified object,
;; otherwise nil.
;;
;; ---------------------
;; Version 1.5 - list argument version - 7/19/2005
;; BreakMethod may be used two ways. The calling function may
;; be passing points derived from IntersectWith. In that case it's
;; not desireable to do closest point to p1 p2 within BM because the points
;; may not be where expected. But with closest point some point will
;; be found regardless. So the object may be broken somewhere unexpected.
;;
;; The other usage is passing points from entsel for instance.
;; Having closest point in BM given that case is a convenience.
;;
;; ---------------------
;; Version 2.0 - 12/31/2005
;; Added support for 3D plines, rays and xlines.
;; revised 5/15/2006 to fix bug at end report.
;; Added if the object was erased, return the object.
;;
;; ---------------------
;; Current version breaks lines, arcs, circles,
;; ellipses (open or closed), lightweight plines
;; (open or closed), heavy plines (open or closed),
;; 3D plines (open or closed), rays and xlines.
;; Does not handle curve objects like splines
;; or fitted, cubic, quadratic plines.
;;
;; Additional functions by others welcome. For example,
;; a function for breaking splines.
;;
;; BreakMethod wants to be an alternative to
;; (command "break"...) using VLisp which
;; mimics the break command exactly given the "first
;; point" "second point" method. Do whatever it
;; does with a particular object type under a given set
;; of circumstances. Includes things like keeping the
;; original object and honoring which point is picked first.
;; For instance with circles, picking clockwise or
;; counter-clockwise determines the result. Similarly,
;; maintain the angle of a line or direction of a
;; pline after break.
;;
;; Potential bugs not yet squashed: any condition which
;; creates duplicate vertices at the start or end of a pline.
;; Not to mention, things I simply haven't considered. :-)
;; TEST FUNCTIONS ;;
;|
;; Revised for arglst 7/18/2005 version 1.5.
;; Revised version 2.0.
;; testCP calls closestpointto for p1 and p2.
(defun c:testCP (/ *error* doc ent p1 p2)
(defun *error* (msg)
(cond
((not msg))
((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
(T (princ (strcat "\nError: " msg)))
)
(vla-EndUndoMark doc)
(princ)
) ;end error
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-EndUndoMark doc)
(vla-StartUndoMark doc)
(while (not (setq ent (car (entsel "\nSelect object: ")))))
(setq p1 (trans (getpoint "\nFirst break point: ") 1 0))
(setq p2 (trans (getpoint "\nSecond break point: ") 1 0))
(print (BreakMethod (list ent p1 p2 T))) ;<< opt-arg T
(*error* nil)
) ;end
;; Revised for arglst 7/18/2005 version 1.5.
;; Revised version 2.0.
;; testNCP doesn't call closestpointto.
(defun c:testNCP (/ *error* doc ent p1 p2)
(defun *error* (msg)
(cond
((not msg))
((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
(T (princ (strcat "\nError: " msg)))
)
(vla-EndUndoMark doc)
(princ)
) ;end error
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-EndUndoMark doc)
(vla-StartUndoMark doc)
(while (not (setq ent (car (entsel "\nSelect object: ")))))
(setq p1 (trans (getpoint "\nFirst break point: ") 1 0))
(setq p2 (trans (getpoint "\nSecond break point: ") 1 0))
(print (BreakMethod (list ent p1 p2))) ;<< opt-arg not supplied
(*error* nil)
) ;end
|;
;; Argument: a list (arglst) containing (object-to-break p1 p2 opt-arg).
;; Where opt-arg determines whether BreakMethod calls closestpointto for p1 and p2.
;; Obj - vla-object or ename. p1 and p2 - two WCS points.
;; Returns: new or modified object if successful, otherwise nil.
(defun BreakMethod (arglst / doc space layobj typ startpt startparam
endpt endparam p1param p2param minparam maxparam
CalcBulge DelZ BreakLine BreakArc BreakCircle
BreakClosedEllipse BreakOpenEllipse BreakOpenLWPline
BreakClosedLWPline BreakOpenPline BreakClosedPline
BreakOpen3DPline BreakClosed3DPline BreakXLine
BreakRay spacecnt res)
;;;; START SUBFUNCTIONS ;;;;
;----------------------------
;; Modified version of a function by Luis Esquivel (rcmd-getBulge)
;; which was based on a function by John Uhden (getBulge).
;; Arguments: obj - a vla-object pline either heavy or lightweight.
;; fromparam - parameter along the obj where the bulge starts.
;; toparam - parameter along the obj where the bulge ends.
;; Returns: the bulge at fromparam.
(defun CalcBulge (obj fromparam toparam /
frompt topt curvept ang chord midcrdpt alt)
(setq frompt (vlax-curve-getPointAtParam obj fromparam)
topt (vlax-curve-getPointAtParam obj toparam)
curvept (vlax-curve-getPointAtParam obj (* 0.5 (+ fromparam toparam)))
ang (angle frompt topt)
chord (distance frompt topt)
midcrdpt (mapcar '* (mapcar '+ frompt topt) '(0.5 0.5 0.5))
alt (distance midcrdpt curvept)
)
(cond
((zerop chord) 0.0)
((equal (angle curvept midcrdpt)
(rem (+ ang (* pi 0.5)) (* pi 2)) 1e-4)
(/ alt chord 0.5))
(T (/ alt chord -0.5))
)
) ;end CalcBulge
;----------------------------
;----------------------------
;; Argument: 3D point list.
;; Returns: point list with Z value removed or
;; the point passed if 2D.
(defun DelZ (pt)
(if (= 3 (length pt))
(list (car pt) (cadr pt))
pt
)
) ;end DelZ
;----------------------------
;----------------------------
(defun BreakLine ( / copyobj)
(cond
((and (equal startpt p1 1e-8) (equal endpt p2 1e-8))
(vla-delete obj))
((equal startpt p1 1e-8)
(vlax-put obj 'StartPoint p2))
((equal endpt p2 1e-8)
(vlax-put obj 'EndPoint p1))
(T
(setq copyobj (vlax-invoke obj 'Copy))
(vlax-put obj 'EndPoint p1)
(vlax-put copyobj 'StartPoint p2)
)
)
) ;end BreakLine
;----------------------------
;----------------------------
(defun BreakArc ( / copyobj)
(cond
((and (equal startpt p1 1e-8) (equal endpt p2 1e-8))
(vla-delete obj))
((equal startpt p1 1e-8)
(vlax-put obj 'StartAngle maxparam))
((equal endpt p2 1e-8)
(vlax-put obj 'EndAngle minparam))
(T
(setq copyobj (vlax-invoke obj 'Copy))
(vlax-put obj 'EndAngle minparam)
(vlax-put copyobj 'StartAngle maxparam)
)
)
) ;end BreakArc
;----------------------------
;----------------------------
(defun BreakOpenEllipse ( / copyobj)
(cond
((and (equal startpt p1 1e-8) (equal endpt p2 1e-8))
(vla-delete obj))
((equal startpt p1 1e-8)
(vlax-put obj 'StartParameter maxparam))
((equal endpt p2 1e-8)
(vlax-put obj 'EndParameter minparam))
(T
(setq copyobj (vlax-invoke obj 'Copy))
(vlax-put obj 'EndParameter minparam)
(vlax-put copyobj 'StartParameter maxparam)
)
)
) ;end BreakOpenEllipse
;----------------------------
;----------------------------
(defun BreakClosedEllipse ( )
(vlax-put obj 'StartParameter maxparam)
(vlax-put obj 'EndParameter (+ minparam (* pi 2)))
) ;end BreakClosedEllipse
;----------------------------
;----------------------------
(defun BreakCircle ( / layname rad cen ltyp ltypscl lwt thk clr)
(setq layname (vlax-get obj 'Layer)
rad (vlax-get obj 'Radius)
cen (vlax-get obj 'Center)
ltyp (vlax-get obj 'Linetype)
ltypscl (vlax-get obj 'LinetypeScale)
lwt (vlax-get obj 'Lineweight)
thk (vlax-get obj 'Thickness)
clr (vlax-get obj 'Color)
)
(vla-delete obj)
(setq obj (vlax-invoke space 'AddArc cen rad p2param p1param))
(vlax-put obj 'Layer layname)
(vlax-put obj 'Linetype ltyp)
(vlax-put obj 'LinetypeScale ltypscl)
(vlax-put obj 'Lineweight lwt)
(vlax-put obj 'Thickness thk)
(vlax-put obj 'Color clr)
) ;end BreakCircle
;----------------------------
;----------------------------
;; Break xlines: two new rays are created. Second ray returned.
(defun BreakXLine ( / layname dirvec ltyp ltypscl lwt clr)
(setq layname (vlax-get obj 'Layer)
dirvec (vlax-get obj 'DirectionVector)
ltyp (vlax-get obj 'Linetype)
ltypscl (vlax-get obj 'LinetypeScale)
lwt (vlax-get obj 'Lineweight)
clr (vlax-get obj 'Color)
)
(vla-delete obj)
(setq obj (vlax-invoke space 'AddRay p1 (mapcar '- p1 dirvec)))
(vlax-put obj 'Layer layname)
(vlax-put obj 'Linetype ltyp)
(vlax-put obj 'LinetypeScale ltypscl)
(vlax-put obj 'Lineweight lwt)
(vlax-put obj 'Color clr)
(setq obj (vlax-invoke space 'AddRay p2 (mapcar '+ p2 dirvec)))
(vlax-put obj 'Layer layname)
(vlax-put obj 'Linetype ltyp)
(vlax-put obj 'LinetypeScale ltypscl)
(vlax-put obj 'Lineweight lwt)
(vlax-put obj 'Color clr)
) ;end BreakXLine
;----------------------------
;----------------------------
;; Break rays: a new line is created beginning at ray basepoint and ending
;; at break point closest to basepoint. The existing ray is modified and
;; returned with basepoint at break point farthest from original basepoint.
;; Mimics what (command "break" ...) does with rays.
;; If break point closest to basepoint is at basepoint, a new line is
;; not created and the modified ray is returned. If both break points
;; are at basepoint, nothing happens and nil is returned.
(defun BreakRay ( / layname basept ltyp ltypscl lwt clr newobj)
(setq layname (vlax-get obj 'Layer)
basept (vlax-get obj 'BasePoint)
ltyp (vlax-get obj 'Linetype)
ltypscl (vlax-get obj 'LinetypeScale)
lwt (vlax-get obj 'Lineweight)
clr (vlax-get obj 'Color)
)
(cond
;add line and modify ray
((and
(not (equal basept p1 1e-8))
(not (equal basept p2 1e-8))
)
(vlax-put obj 'BasePoint p2)
(setq newobj (vlax-invoke space 'AddLine basept p1))
(vlax-put newobj 'Layer layname)
(vlax-put newobj 'Linetype ltyp)
(vlax-put newobj 'LinetypeScale ltypscl)
(vlax-put newobj 'Lineweight lwt)
(vlax-put newobj 'Color clr)
)
;don't add line, just modify ray
((and
(equal basept p1 1e-8)
(not (equal basept p2 1e-8))
)
(vlax-put obj 'BasePoint p2)
)
)
) ;end BreakRay
;----------------------------
;----------------------------
(defun BreakOpenLWPline ( / copyobj fxparam1 fxparam1pt
fxparam2 fxparam2pt ModEnd ModStart)
;modify end of lwpline - keep start vertex
(defun ModEnd (obj / endblg idx blg blglst coord)
;end bulge
(setq endblg (CalcBulge obj fxparam1 minparam))
;bulge list before p1
(setq idx 0)
(repeat fxparam1
(setq blg (vlax-invoke obj 'GetBulge idx))
(setq blglst (append blglst (list blg)))
(setq idx (1+ idx))
)
;add end bulge
(setq blglst (append blglst (list endblg)))
;add vertex at p1 if minparam isn't on a vertex
;and strip trailing vertices
(if (/= minparam (fix minparam))
(vlax-invoke obj 'AddVertex (1+ fxparam1) p1)
)
(setq coord (vlax-get obj 'Coordinates))
(repeat (fix (- endparam fxparam1))
(setq coord (reverse (cddr (reverse coord))))
(vlax-put obj 'Coordinates coord)
)
;apply bulge list
(setq idx 0)
(foreach x blglst
(vlax-invoke obj 'SetBulge idx x)
(setq idx (1+ idx))
)
) ;end ModEnd
;modify start of lwpline - keep end vertex
(defun ModStart (obj / startblg idx blg blglst coord)
;start bulge
(setq startblg (CalcBulge obj maxparam fxparam2))
;bulge list after p2
(setq idx fxparam2)
(repeat (fix (- endparam fxparam2))
(setq blg (vlax-invoke obj 'GetBulge idx))
(setq blglst (append blglst (list blg)))
(setq idx (1+ idx))
)
;add start bulge
(setq blglst (append (list startblg) blglst))
;add vertex at p2 and and strip leading vertices
(vlax-invoke obj 'AddVertex fxparam2 p2)
(setq coord (vlax-get obj 'Coordinates))
(repeat (fix fxparam2)
(setq coord (cddr coord))
(vlax-put obj 'Coordinates coord)
)
;apply bulge list
(setq idx 0)
(foreach x blglst
(vlax-invoke obj 'SetBulge idx x)
(setq idx (1+ idx))
)
) ;end ModStart
;; end subfunctions ;;
(setq startpt (DelZ startpt)
endpt (DelZ endpt)
;vertex before minparam
fxparam1 (fix minparam)
fxparam1pt (vlax-curve-getPointAtParam obj fxparam1)
;2D point closest to startpoint
p1 (DelZ p1)
;2D point closest to endpoint
p2 (DelZ p2)
)
;vertex after maxparam
(if (equal maxparam endparam 1e-8)
(setq fxparam2 endparam)
(setq fxparam2 (1+ (fix maxparam)))
)
(setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2))
(cond
((and (equal p1 startpt 1e-8) (equal p2 endpt 1e-8))
(vla-delete obj))
((equal p1 startpt 1e-8)
(ModStart obj)
)
((equal p2 endpt 1e-8)
(ModEnd obj)
)
(T
(setq copyobj (vlax-invoke obj 'Copy))
(ModEnd obj)
(ModStart copyobj)
)
)
) ;end BreakOpenLWPline
;----------------------------
;----------------------------
(defun BreakClosedLWPline ( / fxparam1 fxparam1pt fxparam2 fxparam2pt
idx pt blg startblg endblg prelst postlst
coord datalst p1lst p2lst fxparam1lst var)
(setq p1 (DelZ p1)
p2 (DelZ p2))
(cond
;point at start vertex
((= minparam 0)
(setq fxparam1 endparam)
)
;point is on vertex
((= minparam (fix minparam))
(setq fxparam1 (1- minparam))
)
;point is not on vertex
(T (setq fxparam1 (fix minparam)))
)
(setq fxparam1pt (DelZ (vlax-curve-getPointAtParam obj fxparam1)))
;vertex param after maxparam
(if (= maxparam endparam)
(setq fxparam2 startparam)
(setq fxparam2 (1+ (fix maxparam)))
)
(setq fxparam2pt (DelZ (vlax-curve-getPointAtParam obj fxparam2)))
;bulge at p2
(setq startblg (CalcBulge obj maxparam fxparam2))
(setq p2lst (list maxparam p2 startblg))
;bulge before p1
(setq endblg (CalcBulge obj fxparam1 minparam))
(setq fxparam1lst (list fxparam1 fxparam1pt endblg))
(setq p1lst (list minparam p1 endblg))
(setq idx 0)
(repeat (fix endparam)
(setq pt (DelZ (vlax-curve-getPointAtParam obj idx)))
(setq blg (vlax-invoke obj 'GetBulge idx))
(cond
;vertices after maxparam
((> idx maxparam)
(setq postlst (append postlst (list (list idx pt blg))))
)
;vertices before minparam w/o the vertex immediately before minparam
((< idx (1- minparam))
(setq prelst (append prelst (list (list idx pt blg))))
)
)
(setq idx (1+ idx))
)
;avoid adding an unneeded vertex at param 0
(if (= 0 (car p1lst))
(setq datalst (append (list p2lst) postlst prelst
(list fxparam1lst)))
(setq datalst (append (list p2lst) postlst prelst
(list fxparam1lst) (list p1lst)))
)
;; Set lwpline not closed and delete one vertex at a
;; time until two vertices remain. Avoids an "unwind error"
;; which occurs with lwplines when more than one vertex
;; is removed at a time.
(vla-put-closed obj :vlax-false)
(setq coord (vlax-get obj 'Coordinates))
(repeat (- (/ (length coord) 2) 2)
(setq coord (cddr coord))
(vlax-put obj 'Coordinates coord)
)
;add vertices as needed
(repeat (- (length datalst) 2)
(vlax-invoke obj 'AddVertex (vlax-curve-getEndParam obj)
(DelZ (vlax-curve-getEndPoint obj)))
)
;rearrange
(setq idx 0)
(foreach lst datalst
(setq var (vlax-make-variant (vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble
(cons 0 (1- (length (cadr lst))))) (cadr lst))))
(vlax-put-property obj 'Coordinate idx var)
(vlax-invoke obj 'SetBulge idx (caddr lst))
(setq idx (1+ idx))
)
) ;end BreakClosedLWPline
;----------------------------
;----------------------------
;; open heavy plines
(defun BreakOpenPline ( / copyobj fxparam1 fxparam1pt
fxparam2 fxparam2pt ModEnd ModStart)
;modify end of heavy pline - keep start point
(defun ModEnd (obj / endblg idx blg blglst coord)
;end bulge
(setq endblg (CalcBulge obj fxparam1 minparam))
;bulge list before p1
(setq idx 0)
(repeat fxparam1
(setq blg (vlax-invoke obj 'GetBulge idx))
(setq blglst (append blglst (list blg)))
(setq idx (1+ idx))
)
;add end bulge
(setq blglst (append blglst (list endblg)))
;strip trailing vertices
(setq coord (vlax-get obj 'Coordinates))
(repeat (fix (- endparam fxparam1))
(setq coord (reverse (cdddr (reverse coord))))
)
;add vertex at p1 if minparam isn't on a vertex
(if (/= minparam (fix minparam))
(vlax-put obj 'Coordinates (append coord p1))
(vlax-put obj 'Coordinates coord)
)
;apply bulge list
(setq idx 0)
(foreach x blglst
(vlax-invoke obj 'SetBulge idx x)
(setq idx (1+ idx))
)
) ;end ModEnd
;modify start of heavy pline - keep end point
(defun ModStart (obj / startblg idx blg blglst coord)
;start bulge
(setq startblg (CalcBulge obj maxparam fxparam2))
;bulge list after p2
(setq idx fxparam2)
(repeat (fix (- endparam fxparam2))
(setq blg (vlax-invoke obj 'GetBulge idx))
(setq blglst (append blglst (list blg)))
(setq idx (1+ idx))
)
;add start bulge
(setq blglst (append (list startblg) blglst))
;strip leading vertices
(setq coord (vlax-get obj 'Coordinates))
(repeat (fix fxparam2)
(setq coord (cdddr coord))
)
;put coordinates
(vlax-put obj 'Coordinates (append p2 coord))
;apply bulge list
(setq idx 0)
(foreach x blglst
(vlax-invoke obj 'SetBulge idx x)
(setq idx (1+ idx))
)
) ;end ModStart
;; end subfunctions ;;
;vertex before minparam
(setq fxparam1 (fix minparam))
(setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1))
;vertex after maxparam
(if (equal maxparam endparam 1e-8)
(setq fxparam2 endparam)
(setq fxparam2 (1+ (fix maxparam)))
)
(setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2))
(cond
((and (equal p1 startpt 1e-8) (equal p2 endpt 1e-8))
(vla-delete obj))
((equal p1 startpt 1e-8)
(ModStart obj)
)
((equal p2 endpt 1e-8)
(ModEnd obj)
)
(T
(setq copyobj (vlax-invoke obj 'Copy))
(ModEnd obj)
(ModStart copyobj)
)
)
) ;end BreakOpenPline
;----------------------------
;----------------------------
;; closed heavy plines
(defun BreakClosedPline ( / fxparam1 fxparam1pt fxparam1lst pt blg idx postlst
prelst ptlst datalst blglst fxparam2 fxparam2pt
startblg endblg p2lst p1lst)
(cond
;point at start vertex
((= minparam 0)
(setq fxparam1 endparam)
)
;point is on vertex
((= minparam (fix minparam))
(setq fxparam1 (1- minparam))
)
;point is not on vertex
(T (setq fxparam1 (fix minparam)))
)
(setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1))
;vertex param after maxparam
(if (= maxparam endparam)
(setq fxparam2 startparam)
(setq fxparam2 (1+ (fix maxparam)))
)
(setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2))
;bulge at p2
(setq startblg (CalcBulge obj maxparam fxparam2))
(setq p2lst (list maxparam p2 startblg))
;bulge before p1
(setq endblg (CalcBulge obj fxparam1 minparam))
(setq fxparam1lst (list fxparam1 fxparam1pt endblg))
(setq p1lst (list minparam p1 endblg))
;make lists before and after vertices
(setq idx 0)
(repeat (fix endparam)
(setq pt (vlax-curve-getPointAtParam obj idx))
(setq blg (vlax-invoke obj 'GetBulge idx))
(cond
;vertices after maxparam
((> idx maxparam)
(setq postlst (append postlst (list (list idx pt blg))))
)
;vertices before minparam w/o the vertex immediately before minparam
((< idx (1- minparam))
(setq prelst (append prelst (list (list idx pt blg))))
)
)
(setq idx (1+ idx))
)
;avoid adding an unneeded vertex at param 0
(if (= 0 (car p1lst))
(setq datalst (append (list p2lst) postlst prelst
(list fxparam1lst)))
(setq datalst (append (list p2lst) postlst prelst
(list fxparam1lst) (list p1lst)))
)
(foreach lst datalst
(setq ptlst (append ptlst (cadr lst)))
(setq blglst (append blglst (list (caddr lst))))
)
(vla-put-closed obj :vlax-false)
(vlax-put obj 'Coordinates ptlst)
;apply blglst
(setq idx 0)
(foreach x blglst
(vlax-invoke obj 'SetBulge idx x)
(setq idx (1+ idx))
)
) ;end BreakClosedPline
;----------------------------
;----------------------------
;; open 3D plines
(defun BreakOpen3DPline ( / copyobj fxparam1 fxparam1pt
fxparam2 fxparam2pt ModEnd ModStart)
;modify end of 3D pline - keep start point
(defun ModEnd (obj / idx coord)
;strip trailing vertices
(setq coord (vlax-get obj 'Coordinates))
(repeat (fix (- endparam fxparam1))
(setq coord (reverse (cdddr (reverse coord))))
)
;add vertex at p1 if minparam isn't on a vertex
(if (/= minparam (fix minparam))
(vlax-put obj 'Coordinates (append coord p1))
(vlax-put obj 'Coordinates coord)
)
) ;end ModEnd
;modify start of heavy pline - keep end point
(defun ModStart (obj / idx coord)
;strip leading vertices
(setq coord (vlax-get obj 'Coordinates))
(repeat (fix fxparam2)
(setq coord (cdddr coord))
)
;put coordinates
(vlax-put obj 'Coordinates (append p2 coord))
) ;end ModStart
;; end subfunctions ;;
;vertex before minparam
(setq fxparam1 (fix minparam))
(setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1))
;vertex after maxparam
(if (equal maxparam endparam 1e-8)
(setq fxparam2 endparam)
(setq fxparam2 (1+ (fix maxparam)))
)
(setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2))
(cond
((and (equal p1 startpt 1e-8) (equal p2 endpt 1e-8))
(vla-delete obj))
((equal p1 startpt 1e-8)
(ModStart obj)
)
((equal p2 endpt 1e-8)
(ModEnd obj)
)
(T
(setq copyobj (vlax-invoke obj 'Copy))
(ModEnd obj)
(ModStart copyobj)
)
)
) ;end BreakOpen3DPline
;----------------------------
;----------------------------
;; closed 3D plines
(defun BreakClosed3DPline ( / fxparam1 fxparam1pt fxparam1lst pt idx postlst
prelst ptlst datalst fxparam2 fxparam2pt p2lst p1lst)
(cond
;point at start vertex
((= minparam 0)
(setq fxparam1 endparam)
)
;point is on vertex
((= minparam (fix minparam))
(setq fxparam1 (1- minparam))
)
;point is not on vertex
(T (setq fxparam1 (fix minparam)))
)
(setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1))
;vertex param after maxparam
(if (= maxparam endparam)
(setq fxparam2 startparam)
(setq fxparam2 (1+ (fix maxparam)))
)
(setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2))
(setq p2lst (list maxparam p2))
(setq fxparam1lst (list fxparam1 fxparam1pt))
(setq p1lst (list minparam p1))
;make lists before and after vertices
(setq idx 0)
(repeat (fix endparam)
(setq pt (vlax-curve-getPointAtParam obj idx))
(cond
;vertices after maxparam
((> idx maxparam)
(setq postlst (append postlst (list (list idx pt))))
)
;vertices before minparam w/o the vertex immediately before minparam
((< idx (1- minparam))
(setq prelst (append prelst (list (list idx pt))))
)
)
(setq idx (1+ idx))
)
;avoid adding an unneeded vertex at param 0
(if (= 0 (car p1lst))
(setq datalst (append (list p2lst) postlst prelst
(list fxparam1lst)))
(setq datalst (append (list p2lst) postlst prelst
(list fxparam1lst) (list p1lst)))
)
(foreach lst datalst
(setq ptlst (append ptlst (cadr lst)))
)
(vla-put-closed obj :vlax-false)
(vlax-put obj 'Coordinates ptlst)
) ;end BreakClosed3DPline
;----------------------------
;;;; END SUBFUNCTIONS ;;;;
;;;; FRONT END ;;;;
(vl-load-com)
(and
(or
(= 3 (length arglst))
(= 4 (length arglst))
)
(setq obj (car arglst))
(cond
((= (type obj) 'VLA-OBJECT))
((= (type obj) 'ENAME)
(setq obj (vlax-ename->vla-object obj))
)
)
(setq p1 (cadr arglst))
(setq p2 (caddr arglst))
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
layobj (vla-item (vla-get-Layers doc) (vlax-get obj 'Layer))
)
(if (= 1 (vlax-get doc 'ActiveSpace))
(setq space (vla-get-ModelSpace doc))
(setq space (vla-get-PaperSpace doc))
)
(setq spacecnt (vlax-get space 'Count))
(setq typ (vlax-get obj 'ObjectName))
(or
(= :vlax-false (vla-get-lock layobj))
(prompt "\nObject is on a locked layer. ")
)
(vl-position typ '("AcDbLine" "AcDbArc" "AcDbCircle" "AcDb3dPolyline"
"AcDbPolyline" "AcDb2dPolyline" "AcDbEllipse" "AcDbXline" "AcDbRay"))
(if (cadddr arglst)
(setq p1 (vlax-curve-getClosestPointTo obj p1)
p2 (vlax-curve-getClosestPointTo obj p2)
)
T
)
;With the vlax-curve functions,
;rays have a startpoint but no endpoint.
;Xlines have neither startpoint or endpoint.
(if (not (eq typ "AcDbXline"))
(and
(setq startpt (vlax-curve-getStartPoint obj))
(setq startparam (vlax-curve-getStartParam obj))
)
T
)
(if
(and
(not (eq typ "AcDbXline"))
(not (eq typ "AcDbRay"))
)
(and
(setq endpt (vlax-curve-getEndPoint obj))
(setq endparam (vlax-curve-getEndParam obj))
)
T
)
;param at first point picked
;Might be a problem here and next line,
;unable to get paramatpoint even with lines, seen 7/10/2005.
;May be due to the fact the param/point was 16 miles from 0,0.
(setq p1param (vlax-curve-getParamAtPoint obj p1))
;param at second point picked
(setq p2param (vlax-curve-getParamAtPoint obj p2))
;param closest to start
(setq minparam (min p1param p2param))
;param closest to end
(setq maxparam (max p1param p2param))
;point closest to start
(setq p1 (vlax-curve-getPointAtParam obj minparam))
;point closest to end
(setq p2 (vlax-curve-getPointAtParam obj maxparam))
;call object type sub-functions
(cond
;line
((= typ "AcDbLine")
(BreakLine)
T
)
;arc
((= typ "AcDbArc")
(BreakArc)
T
)
;open ellipse
((and (= typ "AcDbEllipse")
(not (vlax-curve-isClosed obj)))
(BreakOpenEllipse)
T
)
;closed ellipse
((and (= typ "AcDbEllipse")
(vlax-curve-isClosed obj)
(not (equal minparam maxparam 1e-12)))
(BreakClosedEllipse)
T
)
;circle
((and (= typ "AcDbCircle")
(not (equal minparam maxparam 1e-12)))
(BreakCircle)
T
)
;xline
((= typ "AcDbXline")
(BreakXLine)
T
)
;ray
((= typ "AcDbRay")
(BreakRay)
T
)
;For break behavior which creates a new lwpline when
;break points are at the same point on a closed lwpline.
((and (= typ "AcDbPolyline")
(vlax-curve-isClosed obj)
(equal minparam maxparam 1e-12))
;if /= 0 because break does nothing when
;both points are at param 0
(if (/= 0 minparam)
(progn
(vlax-invoke obj 'AddVertex endparam (DelZ endpt))
(vla-put-closed obj :vlax-false)
(BreakOpenLWPline)
)
)
T
)
;For break behavior which creates a new heavy pline when
;break points are at the same point on a closed heavy pline.
((and (= typ "AcDb2dPolyline")
(vlax-curve-isClosed obj)
(= 0 (vlax-get obj 'Type))
(equal minparam maxparam 1e-12))
;if /= 0 because break does nothing when
;both points are at param 0
(if (/= 0 minparam)
(progn
(vla-put-closed obj :vlax-false)
(vlax-invoke obj 'AppendVertex endpt)
(BreakOpenPline)
)
)
T
)
;For break behavior which creates a new 3D pline when
;break points are at the same point on a 3D pline.
((and (= typ "AcDb3dPolyline")
(vlax-curve-isClosed obj)
(= 0 (vlax-get obj 'Type))
(equal minparam maxparam 1e-12))
;if /= 0 because break does nothing when
;both points are at param 0
(if (/= 0 minparam)
(progn
(vla-put-closed obj :vlax-false)
(vlax-invoke obj 'AppendVertex endpt)
(BreakOpen3DPline)
)
)
T
)
;open lwpline
((and (= typ "AcDbPolyline")
(not (vlax-curve-isClosed obj)))
(not (vlax-property-available-p obj 'Type))
(BreakOpenLWPline)
T
)
;closed lwpline
((and (= typ "AcDbPolyline")
(vlax-curve-isClosed obj))
(not (vlax-property-available-p obj 'Type))
(BreakClosedLWPline)
T
)
;open heavy pline
((and (= typ "AcDb2dPolyline")
(not (vlax-curve-isClosed obj))
(= 0 (vlax-get obj 'Type)))
(BreakOpenPline)
T
)
;closed heavy pline
((and (= typ "AcDb2dPolyline")
(vlax-curve-isClosed obj)
(= 0 (vlax-get obj 'Type)))
(BreakClosedPline)
T
)
;open 3D pline
((and (= typ "AcDb3dPolyline")
(not (vlax-curve-isClosed obj))
(= 0 (vlax-get obj 'Type)))
(BreakOpen3DPline)
T
)
;closed 3D pline
((and (= typ "AcDb3dPolyline")
(vlax-curve-isClosed obj)
(= 0 (vlax-get obj 'Type)))
(BreakClosed3DPline)
T
)
) ;cond
;Return: new or modified or deleted object, otherwise nil.
;See additional notes at BreakRay and BreakXline sub-functions.
(cond
;obj was erased, return the obj - added cond 5/15/2006
((vlax-erased-p obj) (setq res obj))
;new vla-object if one was created
;((/= spacecnt (vlax-get space 'Count)) ;revised
((< spacecnt (vlax-get space 'Count))
;Special cond for rays: if a line was added, return the modified ray.
;If a line wasn't added, the next cond returns the modified ray
;given its start point changed.
(if (= typ "AcDbRay")
(setq res obj)
(setq res (vla-item space spacecnt))
)
)
;or modified vla-object
((or
(and startpt
(not (equal (DelZ startpt) (DelZ (vlax-curve-getStartPoint obj)) 1e-12)))
(and endpt
(not (equal (DelZ endpt) (DelZ (vlax-curve-getEndPoint obj)) 1e-12)))
)
(setq res obj)
)
)
) ;and
res
) ;end BreakMethod

;;  BreakMethod version 1.0 
;;  Joe Burke  6/6/2005 
;; 
;;  Mlines, leaders, dimensions, regions, text objects, 
;;  blocks and solids can't be broken with the break command. 
;;  They are not supported. 
;;  Donuts are supported since they are lwplines. 
;; 
;;  Change history 
;;  --------------------- 
;;  Version 1.1  6/8/2005 
;;  Changed TrueColor property to Color at BreakCircle function. 
;; 
;;  Removed (trans p1 1 0) and (trans p2 1 0) at front end. 
;;  Better to let the calling function ensure points passed are WCS. 
;;  This avoids the possibility of WCS points wrongly transformed 
;;  when the calling function is operating in a UCS. 
;; 
;;  6/11/2005 
;;  At front end, moved type check to start to avoid error 
;;  when passing an ename and trying to get its layer object. 
;; 
;;  6/14/2005 
;;  Added fuzz factor to equal functions at various places. 
;;   
;;  --------------------- 
;;  Version 1.2  6/16/2005 
;;  Added Tim Willey's suggestion. The function returns 
;;  T when the break operation is successful, otherwise nil. 
;; 
;;  --------------------- 
;;  Version 1.3  7/8/2005 
;;  Changed how closed/open ellipse is determined. 
;;  Revised front end: the locked layer check is after setting 
;;  the space variable. So the return T or nil code at the end 
;;  doesn't toss an error (vla-object nil) when the object is 
;;  on a locked layer. 
;;  Revised return T or nil method at end to be an or statement 
;;  rather than condition. 
;; 
;;  Thinking about going back to "cond" rather than "or" 7/11/2005. 
;;  So what's returned is a new object or a modified object. 
;;  Rather than just T when successful. 
;; 
;;  Revised front end so the "and" function checks all setq's. 
;; 
;;  --------------------- 
;;  Version 1.4  7/16/2005 
;;  Added check for arguments obj p1 and p2. 
;;  Moved return function inside "and" function. Revised calls 
;;  to sub-functions so they return T. 
;; 
;;  Now returns a new object if one was created or a modified object, 
;;  otherwise nil. 
;; 
;;  --------------------- 
;;  Version 1.5 - list argument version - 7/19/2005 
;;  BreakMethod may be used two ways. The calling function may 
;;  be passing points derived from IntersectWith. In that case it's 
;;  not desireable to do closest point to p1 p2 within BM because the points 
;;  may not be where expected. But with closest point some point will 
;;  be found regardless. So the object may be broken somewhere unexpected. 
;; 
;;  The other usage is passing points from entsel for instance. 
;;  Having closest point in BM given that case is a convenience. 
;; 
;;  --------------------- 
;;  Version 2.0 - 12/31/2005 
;;  Added support for 3D plines, rays and xlines. 
;;  revised 5/15/2006 to fix bug at end report. 
;;  Added if the object was erased, return the object. 
;; 
;;  --------------------- 
;;  Current version breaks lines, arcs, circles, 
;;  ellipses (open or closed), lightweight plines 
;;  (open or closed), heavy plines (open or closed), 
;;  3D plines (open or closed), rays and xlines. 
;;  Does not handle curve objects like splines 
;;  or fitted, cubic, quadratic plines. 
;; 
;;  Additional functions by others welcome. For example, 
;;  a function for breaking splines. 
;; 
;;  BreakMethod wants to be an alternative to 
;;  (command "break"...) using VLisp which 
;;  mimics the break command exactly given the "first 
;;  point" "second point" method. Do whatever it 
;;  does with a particular object type under a given set 
;;  of circumstances. Includes things like keeping the 
;;  original object and honoring which point is picked first. 
;;  For instance with circles, picking clockwise or 
;;  counter-clockwise determines the result. Similarly, 
;;  maintain the angle of a line or direction of a 
;;  pline after break. 
;; 
;;  Potential bugs not yet squashed: any condition which 
;;  creates duplicate vertices at the start or end of a pline. 
;;  Not to mention, things I simply haven't considered.  :-) 
 
;;  TEST FUNCTIONS  ;; 
 
;| 
;; Revised for arglst 7/18/2005 version 1.5. 
;; Revised version 2.0. 
;; testCP calls closestpointto for p1 and p2. 
(defun c:testCP (/ *error* doc ent p1 p2) 
  (defun *error* (msg) 
    (cond 
      ((not msg)) 
      ((wcmatch (strcase msg) "*QUIT*,*CANCEL*")) 
      (T (princ (strcat "\nError: " msg))) 
    ) 
    (vla-EndUndoMark doc) 
    (princ) 
  ) ;end error 
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (vla-EndUndoMark doc) 
  (vla-StartUndoMark doc) 
  (while (not (setq ent (car (entsel "\nSelect object: "))))) 
  (setq p1 (trans (getpoint "\nFirst break point: ") 1 0)) 
  (setq p2 (trans (getpoint "\nSecond break point: ") 1 0)) 
  (print (BreakMethod (list ent p1 p2 T))) ;<< opt-arg T 
  (*error* nil) 
) ;end 
 
;; Revised for arglst 7/18/2005 version 1.5. 
;; Revised version 2.0. 
;; testNCP doesn't call closestpointto. 
(defun c:testNCP (/ *error* doc ent p1 p2) 
  (defun *error* (msg) 
    (cond 
      ((not msg)) 
      ((wcmatch (strcase msg) "*QUIT*,*CANCEL*")) 
      (T (princ (strcat "\nError: " msg))) 
    ) 
    (vla-EndUndoMark doc) 
    (princ) 
  ) ;end error 
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) 
  (vla-EndUndoMark doc) 
  (vla-StartUndoMark doc) 
  (while (not (setq ent (car (entsel "\nSelect object: "))))) 
  (setq p1 (trans (getpoint "\nFirst break point: ") 1 0)) 
  (setq p2 (trans (getpoint "\nSecond break point: ") 1 0)) 
  (print (BreakMethod (list ent p1 p2))) ;<< opt-arg not supplied 
  (*error* nil) 
) ;end 
|; 
 
 
;; Argument: a list (arglst) containing (object-to-break p1 p2 opt-arg). 
;; Where opt-arg determines whether BreakMethod calls closestpointto for p1 and p2. 
;; Obj - vla-object or ename. p1 and p2 - two WCS points. 
;; Returns: new or modified object if successful, otherwise nil. 
(defun BreakMethod (arglst / doc space layobj typ startpt startparam 
                    endpt endparam p1param p2param minparam maxparam 
                    CalcBulge DelZ BreakLine BreakArc BreakCircle 
                    BreakClosedEllipse BreakOpenEllipse BreakOpenLWPline 
                    BreakClosedLWPline BreakOpenPline BreakClosedPline 
                    BreakOpen3DPline BreakClosed3DPline BreakXLine 
                    BreakRay spacecnt res) 
 
  ;;;; START SUBFUNCTIONS ;;;; 
 
  ;---------------------------- 
  ;; Modified version of a function by Luis Esquivel (rcmd-getBulge) 
  ;; which was based on a function by John Uhden (getBulge). 
  ;; Arguments: obj - a vla-object pline either heavy or lightweight. 
  ;;            fromparam - parameter along the obj where the bulge starts. 
  ;;            toparam - parameter along the obj where the bulge ends. 
  ;; Returns: the bulge at fromparam. 
  (defun CalcBulge (obj fromparam toparam / 
                    frompt topt curvept ang chord midcrdpt alt) 
    (setq frompt (vlax-curve-getPointAtParam obj fromparam) 
          topt (vlax-curve-getPointAtParam obj toparam) 
          curvept (vlax-curve-getPointAtParam obj (* 0.5 (+ fromparam toparam))) 
          ang (angle frompt topt) 
          chord (distance frompt topt) 
          midcrdpt (mapcar '* (mapcar '+ frompt topt) '(0.5 0.5 0.5)) 
          alt (distance midcrdpt curvept) 
    ) 
    (cond 
      ((zerop chord) 0.0) 
      ((equal (angle curvept midcrdpt) 
        (rem (+ ang (* pi 0.5)) (* pi 2)) 1e-4) 
        (/ alt chord 0.5)) 
      (T (/ alt chord -0.5)) 
    ) 
  ) ;end CalcBulge 
  ;---------------------------- 
 
  ;---------------------------- 
  ;; Argument: 3D point list. 
  ;; Returns: point list with Z value removed or 
  ;; the point passed if 2D. 
  (defun DelZ (pt) 
    (if (= 3 (length pt)) 
      (list (car pt) (cadr pt)) 
      pt 
    ) 
  ) ;end DelZ 
  ;---------------------------- 
 
  ;---------------------------- 
  (defun BreakLine ( / copyobj) 
    (cond 
      ((and (equal startpt p1 1e-8) (equal endpt p2 1e-8)) 
        (vla-delete obj)) 
      ((equal startpt p1 1e-8) 
        (vlax-put obj 'StartPoint p2)) 
      ((equal endpt p2 1e-8) 
        (vlax-put obj 'EndPoint p1)) 
      (T 
        (setq copyobj (vlax-invoke obj 'Copy)) 
        (vlax-put obj 'EndPoint p1) 
        (vlax-put copyobj 'StartPoint p2) 
      ) 
    ) 
  ) ;end BreakLine 
  ;---------------------------- 
 
  ;---------------------------- 
  (defun BreakArc ( / copyobj) 
    (cond 
      ((and (equal startpt p1 1e-8) (equal endpt p2 1e-8)) 
        (vla-delete obj)) 
      ((equal startpt p1 1e-8) 
        (vlax-put obj 'StartAngle maxparam)) 
      ((equal endpt p2 1e-8) 
        (vlax-put obj 'EndAngle minparam)) 
      (T 
        (setq copyobj (vlax-invoke obj 'Copy)) 
        (vlax-put obj 'EndAngle minparam) 
        (vlax-put copyobj 'StartAngle maxparam) 
      ) 
    ) 
  ) ;end BreakArc 
  ;---------------------------- 
 
  ;---------------------------- 
  (defun BreakOpenEllipse ( / copyobj) 
    (cond 
      ((and (equal startpt p1 1e-8) (equal endpt p2 1e-8)) 
        (vla-delete obj)) 
      ((equal startpt p1 1e-8) 
        (vlax-put obj 'StartParameter maxparam)) 
      ((equal endpt p2 1e-8) 
        (vlax-put obj 'EndParameter minparam)) 
      (T 
        (setq copyobj (vlax-invoke obj 'Copy)) 
        (vlax-put obj 'EndParameter minparam) 
        (vlax-put copyobj 'StartParameter maxparam) 
      ) 
    ) 
  ) ;end BreakOpenEllipse 
  ;---------------------------- 
 
  ;---------------------------- 
  (defun BreakClosedEllipse ( ) 
    (vlax-put obj 'StartParameter maxparam) 
    (vlax-put obj 'EndParameter (+ minparam (* pi 2))) 
  ) ;end BreakClosedEllipse 
  ;---------------------------- 
 
  ;---------------------------- 
  (defun BreakCircle ( / layname rad cen ltyp ltypscl lwt thk clr) 
    (setq layname (vlax-get obj 'Layer) 
          rad (vlax-get obj 'Radius) 
          cen (vlax-get obj 'Center) 
          ltyp (vlax-get obj 'Linetype) 
          ltypscl (vlax-get obj 'LinetypeScale) 
          lwt (vlax-get obj 'Lineweight) 
          thk (vlax-get obj 'Thickness) 
          clr (vlax-get obj 'Color) 
    ) 
    (vla-delete obj) 
    (setq obj (vlax-invoke space 'AddArc cen rad p2param p1param)) 
    (vlax-put obj 'Layer layname) 
    (vlax-put obj 'Linetype ltyp) 
    (vlax-put obj 'LinetypeScale ltypscl) 
    (vlax-put obj 'Lineweight lwt) 
    (vlax-put obj 'Thickness thk) 
    (vlax-put obj 'Color clr) 
  ) ;end BreakCircle 
  ;---------------------------- 
   
  ;---------------------------- 
  ;; Break xlines: two new rays are created. Second ray returned. 
  (defun BreakXLine ( / layname dirvec ltyp ltypscl lwt clr) 
    (setq layname (vlax-get obj 'Layer) 
          dirvec (vlax-get obj 'DirectionVector) 
          ltyp (vlax-get obj 'Linetype) 
          ltypscl (vlax-get obj 'LinetypeScale) 
          lwt (vlax-get obj 'Lineweight) 
          clr (vlax-get obj 'Color) 
    ) 
    (vla-delete obj) 
    (setq obj (vlax-invoke space 'AddRay p1 (mapcar '- p1 dirvec))) 
    (vlax-put obj 'Layer layname) 
    (vlax-put obj 'Linetype ltyp) 
    (vlax-put obj 'LinetypeScale ltypscl) 
    (vlax-put obj 'Lineweight lwt) 
    (vlax-put obj 'Color clr) 
    (setq obj (vlax-invoke space 'AddRay p2 (mapcar '+ p2 dirvec))) 
    (vlax-put obj 'Layer layname) 
    (vlax-put obj 'Linetype ltyp) 
    (vlax-put obj 'LinetypeScale ltypscl) 
    (vlax-put obj 'Lineweight lwt) 
    (vlax-put obj 'Color clr) 
  ) ;end BreakXLine 
  ;---------------------------- 
   
  ;---------------------------- 
  ;; Break rays: a new line is created beginning at ray basepoint and ending 
  ;; at break point closest to basepoint. The existing ray is modified and 
  ;; returned with basepoint at break point farthest from original basepoint. 
  ;; Mimics what (command "break" ...) does with rays. 
  ;; If break point closest to basepoint is at basepoint, a new line is 
  ;; not created and the modified ray is returned. If both break points 
  ;; are at basepoint, nothing happens and nil is returned. 
  (defun BreakRay ( / layname basept ltyp ltypscl lwt clr newobj) 
    (setq layname (vlax-get obj 'Layer) 
          basept (vlax-get obj 'BasePoint) 
          ltyp (vlax-get obj 'Linetype) 
          ltypscl (vlax-get obj 'LinetypeScale) 
          lwt (vlax-get obj 'Lineweight) 
          clr (vlax-get obj 'Color) 
    ) 
    (cond 
      ;add line and modify ray 
      ((and 
         (not (equal basept p1 1e-8)) 
         (not (equal basept p2 1e-8)) 
        ) 
        (vlax-put obj 'BasePoint p2) 
        (setq newobj (vlax-invoke space 'AddLine basept p1)) 
        (vlax-put newobj 'Layer layname) 
        (vlax-put newobj 'Linetype ltyp) 
        (vlax-put newobj 'LinetypeScale ltypscl) 
        (vlax-put newobj 'Lineweight lwt) 
        (vlax-put newobj 'Color clr) 
      ) 
      ;don't add line, just modify ray 
      ((and 
         (equal basept p1 1e-8) 
         (not (equal basept p2 1e-8)) 
        ) 
        (vlax-put obj 'BasePoint p2) 
      ) 
    ) 
  ) ;end BreakRay 
  ;---------------------------- 
 
  ;---------------------------- 
  (defun BreakOpenLWPline ( / copyobj fxparam1 fxparam1pt 
                              fxparam2 fxparam2pt ModEnd ModStart) 
 
    ;modify end of lwpline - keep start vertex 
    (defun ModEnd (obj / endblg idx blg blglst coord) 
 
      ;end bulge 
      (setq endblg (CalcBulge obj fxparam1 minparam)) 
 
      ;bulge list before p1 
      (setq idx 0) 
      (repeat fxparam1 
        (setq blg (vlax-invoke obj 'GetBulge idx)) 
        (setq blglst (append blglst (list blg))) 
        (setq idx (1+ idx)) 
      ) 
      ;add end bulge 
      (setq blglst (append blglst (list endblg))) 
 
      ;add vertex at p1 if minparam isn't on a vertex 
      ;and strip trailing vertices 
      (if (/= minparam (fix minparam)) 
        (vlax-invoke obj 'AddVertex (1+ fxparam1) p1) 
      ) 
      (setq coord (vlax-get obj 'Coordinates)) 
      (repeat (fix (- endparam fxparam1)) 
        (setq coord (reverse (cddr (reverse coord)))) 
        (vlax-put obj 'Coordinates coord) 
      ) 
 
      ;apply bulge list 
      (setq idx 0) 
      (foreach x blglst 
        (vlax-invoke obj 'SetBulge idx x) 
        (setq idx (1+ idx)) 
      ) 
    ) ;end ModEnd 
 
    ;modify start of lwpline - keep end vertex 
    (defun ModStart (obj / startblg idx blg blglst coord) 
 
      ;start bulge 
      (setq startblg (CalcBulge obj maxparam fxparam2)) 
 
      ;bulge list after p2 
      (setq idx fxparam2) 
      (repeat (fix (- endparam fxparam2)) 
        (setq blg (vlax-invoke obj 'GetBulge idx)) 
        (setq blglst (append blglst (list blg))) 
        (setq idx (1+ idx)) 
      ) 
      ;add start bulge 
      (setq blglst (append (list startblg) blglst)) 
 
      ;add vertex at p2 and and strip leading vertices 
      (vlax-invoke obj 'AddVertex fxparam2 p2) 
      (setq coord (vlax-get obj 'Coordinates)) 
      (repeat (fix fxparam2) 
        (setq coord (cddr coord)) 
        (vlax-put obj 'Coordinates coord) 
      ) 
 
      ;apply bulge list 
      (setq idx 0) 
      (foreach x blglst 
         (vlax-invoke obj 'SetBulge idx x) 
         (setq idx (1+ idx)) 
       ) 
    ) ;end ModStart 
    ;; end subfunctions ;; 
 
    (setq startpt (DelZ startpt) 
          endpt (DelZ endpt) 
          ;vertex before minparam 
          fxparam1 (fix minparam) 
          fxparam1pt (vlax-curve-getPointAtParam obj fxparam1) 
          ;2D point closest to startpoint 
          p1 (DelZ p1) 
          ;2D point closest to endpoint 
          p2 (DelZ p2) 
    ) 
 
    ;vertex after maxparam 
    (if (equal maxparam endparam 1e-8) 
      (setq fxparam2 endparam) 
      (setq fxparam2 (1+ (fix maxparam))) 
    ) 
    (setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2)) 
 
    (cond 
      ((and (equal p1 startpt 1e-8) (equal p2 endpt 1e-8)) 
        (vla-delete obj)) 
      ((equal p1 startpt 1e-8) 
        (ModStart obj) 
      ) 
      ((equal p2 endpt 1e-8) 
        (ModEnd obj) 
      ) 
      (T 
        (setq copyobj (vlax-invoke obj 'Copy)) 
        (ModEnd obj) 
        (ModStart copyobj) 
      ) 
    ) 
  ) ;end BreakOpenLWPline 
  ;---------------------------- 
 
  ;---------------------------- 
  (defun BreakClosedLWPline ( / fxparam1 fxparam1pt fxparam2 fxparam2pt 
                                idx pt blg startblg endblg prelst postlst 
                                coord datalst p1lst p2lst fxparam1lst var) 
 
    (setq p1 (DelZ p1) 
          p2 (DelZ p2)) 
    (cond 
      ;point at start vertex 
      ((= minparam 0) 
        (setq fxparam1 endparam) 
      ) 
      ;point is on vertex 
      ((= minparam (fix minparam)) 
        (setq fxparam1 (1- minparam)) 
      ) 
      ;point is not on vertex 
      (T (setq fxparam1 (fix minparam))) 
    ) 
    (setq fxparam1pt (DelZ (vlax-curve-getPointAtParam obj fxparam1))) 
 
    ;vertex param after maxparam 
    (if (= maxparam endparam) 
      (setq fxparam2 startparam) 
      (setq fxparam2 (1+ (fix maxparam))) 
    ) 
    (setq fxparam2pt (DelZ (vlax-curve-getPointAtParam obj fxparam2))) 
 
    ;bulge at p2 
    (setq startblg (CalcBulge obj maxparam fxparam2)) 
    (setq p2lst (list maxparam p2 startblg)) 
 
    ;bulge before p1 
    (setq endblg (CalcBulge obj fxparam1 minparam)) 
    (setq fxparam1lst (list fxparam1 fxparam1pt endblg)) 
 
    (setq p1lst (list minparam p1 endblg)) 
 
    (setq idx 0) 
    (repeat (fix endparam) 
      (setq pt (DelZ (vlax-curve-getPointAtParam obj idx))) 
      (setq blg (vlax-invoke obj 'GetBulge idx)) 
      (cond 
        ;vertices after maxparam 
        ((> idx maxparam) 
          (setq postlst (append postlst (list (list idx pt blg)))) 
        ) 
        ;vertices before minparam w/o the vertex immediately before minparam 
        ((< idx (1- minparam)) 
          (setq prelst (append prelst (list (list idx pt blg)))) 
        ) 
      ) 
      (setq idx (1+ idx)) 
    ) 
 
    ;avoid adding an unneeded vertex at param 0 
    (if (= 0 (car p1lst)) 
      (setq datalst (append (list p2lst) postlst prelst 
                          (list fxparam1lst)))    
      (setq datalst (append (list p2lst) postlst prelst 
                          (list fxparam1lst) (list p1lst))) 
    ) 
 
    ;; Set lwpline not closed and delete one vertex at a 
    ;; time until two vertices remain. Avoids an "unwind error" 
    ;; which occurs with lwplines when more than one vertex 
    ;; is removed at a time. 
    (vla-put-closed obj :vlax-false) 
    (setq coord (vlax-get obj 'Coordinates)) 
    (repeat (- (/ (length coord) 2) 2) 
      (setq coord (cddr coord)) 
      (vlax-put obj 'Coordinates coord) 
    ) 
 
    ;add vertices as needed 
    (repeat (- (length datalst) 2) 
      (vlax-invoke obj 'AddVertex (vlax-curve-getEndParam obj) 
        (DelZ (vlax-curve-getEndPoint obj))) 
    ) 
 
    ;rearrange 
    (setq idx 0) 
    (foreach lst datalst 
      (setq var (vlax-make-variant (vlax-safearray-fill 
        (vlax-make-safearray vlax-vbdouble 
          (cons 0 (1- (length (cadr lst))))) (cadr lst)))) 
      (vlax-put-property obj 'Coordinate idx var) 
      (vlax-invoke obj 'SetBulge idx (caddr lst)) 
      (setq idx (1+ idx)) 
    ) 
  ) ;end BreakClosedLWPline 
  ;---------------------------- 
 
  ;---------------------------- 
  ;; open heavy plines 
  (defun BreakOpenPline ( / copyobj fxparam1 fxparam1pt 
                            fxparam2 fxparam2pt ModEnd ModStart) 
 
    ;modify end of heavy pline - keep start point 
    (defun ModEnd (obj / endblg idx blg blglst coord) 
 
      ;end bulge 
      (setq endblg (CalcBulge obj fxparam1 minparam)) 
 
      ;bulge list before p1 
      (setq idx 0) 
      (repeat fxparam1 
        (setq blg (vlax-invoke obj 'GetBulge idx)) 
        (setq blglst (append blglst (list blg))) 
        (setq idx (1+ idx)) 
      ) 
      ;add end bulge 
      (setq blglst (append blglst (list endblg))) 
 
      ;strip trailing vertices 
      (setq coord (vlax-get obj 'Coordinates)) 
      (repeat (fix (- endparam fxparam1)) 
        (setq coord (reverse (cdddr (reverse coord)))) 
      ) 
 
      ;add vertex at p1 if minparam isn't on a vertex 
      (if (/= minparam (fix minparam)) 
        (vlax-put obj 'Coordinates (append coord p1)) 
        (vlax-put obj 'Coordinates coord) 
      ) 
 
      ;apply bulge list 
      (setq idx 0) 
      (foreach x blglst 
        (vlax-invoke obj 'SetBulge idx x) 
        (setq idx (1+ idx)) 
      ) 
    ) ;end ModEnd 
 
    ;modify start of heavy pline - keep end point 
    (defun ModStart (obj / startblg idx blg blglst coord) 
 
      ;start bulge 
      (setq startblg (CalcBulge obj maxparam fxparam2)) 
 
      ;bulge list after p2 
      (setq idx fxparam2) 
      (repeat (fix (- endparam fxparam2)) 
        (setq blg (vlax-invoke obj 'GetBulge idx)) 
        (setq blglst (append blglst (list blg))) 
        (setq idx (1+ idx)) 
      ) 
      ;add start bulge 
      (setq blglst (append (list startblg) blglst)) 
 
      ;strip leading vertices 
      (setq coord (vlax-get obj 'Coordinates)) 
      (repeat (fix fxparam2) 
        (setq coord (cdddr coord)) 
      ) 
 
      ;put coordinates 
      (vlax-put obj 'Coordinates (append p2 coord)) 
 
      ;apply bulge list 
      (setq idx 0) 
      (foreach x blglst 
         (vlax-invoke obj 'SetBulge idx x) 
         (setq idx (1+ idx)) 
       ) 
    ) ;end ModStart 
    ;; end subfunctions ;; 
 
    ;vertex before minparam 
    (setq fxparam1 (fix minparam)) 
    (setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1)) 
 
    ;vertex after maxparam 
    (if (equal maxparam endparam 1e-8) 
      (setq fxparam2 endparam) 
      (setq fxparam2 (1+ (fix maxparam))) 
    ) 
    (setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2)) 
 
    (cond 
      ((and (equal p1 startpt 1e-8) (equal p2 endpt 1e-8)) 
        (vla-delete obj)) 
      ((equal p1 startpt 1e-8) 
        (ModStart obj) 
      ) 
      ((equal p2 endpt 1e-8) 
        (ModEnd obj) 
      ) 
      (T 
        (setq copyobj (vlax-invoke obj 'Copy)) 
        (ModEnd obj) 
        (ModStart copyobj) 
      ) 
    ) 
  ) ;end BreakOpenPline 
  ;---------------------------- 
 
  ;---------------------------- 
  ;; closed heavy plines 
  (defun BreakClosedPline ( / fxparam1 fxparam1pt fxparam1lst pt blg idx postlst 
                              prelst ptlst datalst blglst fxparam2 fxparam2pt 
                              startblg endblg p2lst p1lst) 
 
    (cond 
      ;point at start vertex 
      ((= minparam 0) 
        (setq fxparam1 endparam) 
      ) 
      ;point is on vertex 
      ((= minparam (fix minparam)) 
        (setq fxparam1 (1- minparam)) 
      ) 
      ;point is not on vertex 
      (T (setq fxparam1 (fix minparam))) 
    ) 
    (setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1)) 
 
    ;vertex param after maxparam 
    (if (= maxparam endparam) 
      (setq fxparam2 startparam) 
      (setq fxparam2 (1+ (fix maxparam))) 
    ) 
    (setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2)) 
 
    ;bulge at p2 
    (setq startblg (CalcBulge obj maxparam fxparam2)) 
    (setq p2lst (list maxparam p2 startblg)) 
 
    ;bulge before p1 
    (setq endblg (CalcBulge obj fxparam1 minparam)) 
 
    (setq fxparam1lst (list fxparam1 fxparam1pt endblg)) 
 
    (setq p1lst (list minparam p1 endblg)) 
 
    ;make lists before and after vertices 
    (setq idx 0) 
    (repeat (fix endparam) 
      (setq pt (vlax-curve-getPointAtParam obj idx)) 
      (setq blg (vlax-invoke obj 'GetBulge idx)) 
      (cond 
        ;vertices after maxparam 
        ((> idx maxparam) 
          (setq postlst (append postlst (list (list idx pt blg)))) 
        ) 
        ;vertices before minparam w/o the vertex immediately before minparam 
        ((< idx (1- minparam)) 
          (setq prelst (append prelst (list (list idx pt blg)))) 
        ) 
      ) 
      (setq idx (1+ idx)) 
    ) 
 
    ;avoid adding an unneeded vertex at param 0 
    (if (= 0 (car p1lst)) 
      (setq datalst (append (list p2lst) postlst prelst 
                          (list fxparam1lst))) 
      (setq datalst (append (list p2lst) postlst prelst 
                          (list fxparam1lst) (list p1lst))) 
    ) 
 
    (foreach lst datalst 
      (setq ptlst (append ptlst (cadr lst))) 
      (setq blglst (append blglst (list (caddr lst)))) 
    ) 
 
    (vla-put-closed obj :vlax-false) 
    (vlax-put obj 'Coordinates ptlst) 
 
    ;apply blglst 
    (setq idx 0) 
    (foreach x blglst 
      (vlax-invoke obj 'SetBulge idx x) 
      (setq idx (1+ idx)) 
    ) 
  ) ;end BreakClosedPline 
  ;---------------------------- 
 
  ;---------------------------- 
  ;; open 3D plines 
  (defun BreakOpen3DPline ( / copyobj fxparam1 fxparam1pt 
                            fxparam2 fxparam2pt ModEnd ModStart) 
 
    ;modify end of 3D pline - keep start point 
    (defun ModEnd (obj / idx coord) 
 
      ;strip trailing vertices 
      (setq coord (vlax-get obj 'Coordinates)) 
      (repeat (fix (- endparam fxparam1)) 
        (setq coord (reverse (cdddr (reverse coord)))) 
      ) 
 
      ;add vertex at p1 if minparam isn't on a vertex 
      (if (/= minparam (fix minparam)) 
        (vlax-put obj 'Coordinates (append coord p1)) 
        (vlax-put obj 'Coordinates coord) 
      ) 
    ) ;end ModEnd 
 
    ;modify start of heavy pline - keep end point 
    (defun ModStart (obj / idx coord) 
 
      ;strip leading vertices 
      (setq coord (vlax-get obj 'Coordinates)) 
      (repeat (fix fxparam2) 
        (setq coord (cdddr coord)) 
      ) 
 
      ;put coordinates 
      (vlax-put obj 'Coordinates (append p2 coord)) 
    ) ;end ModStart 
    ;; end subfunctions ;; 
 
    ;vertex before minparam 
    (setq fxparam1 (fix minparam)) 
    (setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1)) 
 
    ;vertex after maxparam 
    (if (equal maxparam endparam 1e-8) 
      (setq fxparam2 endparam) 
      (setq fxparam2 (1+ (fix maxparam))) 
    ) 
    (setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2)) 
 
    (cond 
      ((and (equal p1 startpt 1e-8) (equal p2 endpt 1e-8)) 
        (vla-delete obj)) 
      ((equal p1 startpt 1e-8) 
        (ModStart obj) 
      ) 
      ((equal p2 endpt 1e-8) 
        (ModEnd obj) 
      ) 
      (T 
        (setq copyobj (vlax-invoke obj 'Copy)) 
        (ModEnd obj) 
        (ModStart copyobj) 
      ) 
    ) 
  ) ;end BreakOpen3DPline 
  ;---------------------------- 
 
  ;---------------------------- 
  ;; closed 3D plines 
  (defun BreakClosed3DPline ( / fxparam1 fxparam1pt fxparam1lst pt idx postlst 
                              prelst ptlst datalst fxparam2 fxparam2pt p2lst p1lst) 
 
    (cond 
      ;point at start vertex 
      ((= minparam 0) 
        (setq fxparam1 endparam) 
      ) 
      ;point is on vertex 
      ((= minparam (fix minparam)) 
        (setq fxparam1 (1- minparam)) 
      ) 
      ;point is not on vertex 
      (T (setq fxparam1 (fix minparam))) 
    ) 
    (setq fxparam1pt (vlax-curve-getPointAtParam obj fxparam1)) 
 
    ;vertex param after maxparam 
    (if (= maxparam endparam) 
      (setq fxparam2 startparam) 
      (setq fxparam2 (1+ (fix maxparam))) 
    ) 
    (setq fxparam2pt (vlax-curve-getPointAtParam obj fxparam2)) 
 
    (setq p2lst (list maxparam p2)) 
 
    (setq fxparam1lst (list fxparam1 fxparam1pt)) 
 
    (setq p1lst (list minparam p1)) 
 
    ;make lists before and after vertices 
    (setq idx 0) 
    (repeat (fix endparam) 
      (setq pt (vlax-curve-getPointAtParam obj idx)) 
      (cond 
        ;vertices after maxparam 
        ((> idx maxparam) 
          (setq postlst (append postlst (list (list idx pt)))) 
        ) 
        ;vertices before minparam w/o the vertex immediately before minparam 
        ((< idx (1- minparam)) 
          (setq prelst (append prelst (list (list idx pt)))) 
        ) 
      ) 
      (setq idx (1+ idx)) 
    ) 
 
    ;avoid adding an unneeded vertex at param 0 
    (if (= 0 (car p1lst)) 
      (setq datalst (append (list p2lst) postlst prelst 
                          (list fxparam1lst))) 
      (setq datalst (append (list p2lst) postlst prelst 
                          (list fxparam1lst) (list p1lst))) 
    ) 
 
    (foreach lst datalst 
      (setq ptlst (append ptlst (cadr lst))) 
    ) 
 
    (vla-put-closed obj :vlax-false) 
    (vlax-put obj 'Coordinates ptlst) 
 
  ) ;end BreakClosed3DPline 
  ;---------------------------- 
 
  ;;;; END SUBFUNCTIONS ;;;; 
 
 
  ;;;; FRONT END ;;;; 
 
  (vl-load-com) 
  (and 
    (or 
      (= 3 (length arglst)) 
      (= 4 (length arglst)) 
    ) 
    (setq obj (car arglst)) 
    (cond 
      ((= (type obj) 'VLA-OBJECT)) 
      ((= (type obj) 'ENAME) 
        (setq obj (vlax-ename->vla-object obj)) 
      ) 
    ) 
    (setq p1 (cadr arglst)) 
    (setq p2 (caddr arglst)) 
    (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) 
          layobj (vla-item (vla-get-Layers doc) (vlax-get obj 'Layer)) 
    ) 
    (if (= 1 (vlax-get doc 'ActiveSpace)) 
      (setq space (vla-get-ModelSpace doc)) 
      (setq space (vla-get-PaperSpace doc)) 
    ) 
    (setq spacecnt (vlax-get space 'Count)) 
    (setq typ (vlax-get obj 'ObjectName)) 
    (or 
      (= :vlax-false (vla-get-lock layobj)) 
      (prompt "\nObject is on a locked layer. ") 
    ) 
    (vl-position typ '("AcDbLine" "AcDbArc" "AcDbCircle" "AcDb3dPolyline" 
       "AcDbPolyline" "AcDb2dPolyline" "AcDbEllipse" "AcDbXline" "AcDbRay"))    
    (if (cadddr arglst) 
      (setq p1 (vlax-curve-getClosestPointTo obj p1) 
            p2 (vlax-curve-getClosestPointTo obj p2) 
      ) 
      T 
    ) 
    ;With the vlax-curve functions, 
    ;rays have a startpoint but no endpoint. 
    ;Xlines have neither startpoint or endpoint. 
    (if (not (eq typ "AcDbXline")) 
      (and 
        (setq startpt (vlax-curve-getStartPoint obj)) 
        (setq startparam (vlax-curve-getStartParam obj)) 
      ) 
      T 
    ) 
    (if 
      (and 
        (not (eq typ "AcDbXline")) 
        (not (eq typ "AcDbRay")) 
      ) 
      (and 
        (setq endpt (vlax-curve-getEndPoint obj)) 
        (setq endparam (vlax-curve-getEndParam obj)) 
      ) 
      T 
    ) 
    ;param at first point picked 
    ;Might be a problem here and next line, 
    ;unable to get paramatpoint even with lines, seen 7/10/2005. 
    ;May be due to the fact the param/point was 16 miles from 0,0. 
    (setq p1param (vlax-curve-getParamAtPoint obj p1)) 
    ;param at second point picked 
    (setq p2param (vlax-curve-getParamAtPoint obj p2)) 
    ;param closest to start 
    (setq minparam (min p1param p2param)) 
    ;param closest to end 
    (setq maxparam (max p1param p2param)) 
    ;point closest to start 
    (setq p1 (vlax-curve-getPointAtParam obj minparam)) 
    ;point closest to end 
    (setq p2 (vlax-curve-getPointAtParam obj maxparam)) 
 
    ;call object type sub-functions 
    (cond 
      ;line 
      ((= typ "AcDbLine") 
        (BreakLine) 
        T 
      ) 
      ;arc 
      ((= typ "AcDbArc") 
        (BreakArc) 
        T 
      ) 
      ;open ellipse 
      ((and (= typ "AcDbEllipse") 
            (not (vlax-curve-isClosed obj))) 
        (BreakOpenEllipse) 
        T 
      ) 
      ;closed ellipse 
      ((and (= typ "AcDbEllipse") 
            (vlax-curve-isClosed obj) 
            (not (equal minparam maxparam 1e-12))) 
        (BreakClosedEllipse) 
        T 
      ) 
      ;circle 
      ((and (= typ "AcDbCircle") 
            (not (equal minparam maxparam 1e-12))) 
        (BreakCircle) 
        T 
      ) 
      ;xline 
      ((= typ "AcDbXline") 
        (BreakXLine) 
        T 
      ) 
      ;ray 
      ((= typ "AcDbRay") 
        (BreakRay) 
        T 
      ) 
 
      ;For break behavior which creates a new lwpline when 
      ;break points are at the same point on a closed lwpline. 
      ((and (= typ "AcDbPolyline") 
            (vlax-curve-isClosed obj) 
            (equal minparam maxparam 1e-12)) 
 
        ;if /= 0 because break does nothing when 
        ;both points are at param 0 
        (if (/= 0 minparam) 
          (progn 
            (vlax-invoke obj 'AddVertex endparam (DelZ endpt)) 
            (vla-put-closed obj :vlax-false) 
            (BreakOpenLWPline) 
          ) 
        ) 
        T 
      ) 
 
      ;For break behavior which creates a new heavy pline when 
      ;break points are at the same point on a closed heavy pline. 
      ((and (= typ "AcDb2dPolyline") 
            (vlax-curve-isClosed obj) 
            (= 0 (vlax-get obj 'Type)) 
            (equal minparam maxparam 1e-12)) 
 
        ;if /= 0 because break does nothing when 
        ;both points are at param 0 
        (if (/= 0 minparam) 
          (progn 
            (vla-put-closed obj :vlax-false) 
            (vlax-invoke obj 'AppendVertex endpt) 
            (BreakOpenPline) 
          ) 
        ) 
        T 
      ) 
 
      ;For break behavior which creates a new 3D pline when 
      ;break points are at the same point on a 3D pline. 
      ((and (= typ "AcDb3dPolyline") 
            (vlax-curve-isClosed obj) 
            (= 0 (vlax-get obj 'Type)) 
            (equal minparam maxparam 1e-12)) 
 
        ;if /= 0 because break does nothing when 
        ;both points are at param 0 
        (if (/= 0 minparam) 
          (progn 
            (vla-put-closed obj :vlax-false) 
            (vlax-invoke obj 'AppendVertex endpt) 
            (BreakOpen3DPline) 
          ) 
        ) 
        T 
      ) 
 
      ;open lwpline 
      ((and (= typ "AcDbPolyline") 
            (not (vlax-curve-isClosed obj))) 
            (not (vlax-property-available-p obj 'Type)) 
        (BreakOpenLWPline) 
        T 
      ) 
      ;closed lwpline 
      ((and (= typ "AcDbPolyline") 
            (vlax-curve-isClosed obj)) 
            (not (vlax-property-available-p obj 'Type)) 
        (BreakClosedLWPline) 
        T 
      ) 
      ;open heavy pline 
      ((and (= typ "AcDb2dPolyline") 
            (not (vlax-curve-isClosed obj)) 
            (= 0 (vlax-get obj 'Type))) 
        (BreakOpenPline) 
        T 
      ) 
      ;closed heavy pline 
      ((and (= typ "AcDb2dPolyline") 
            (vlax-curve-isClosed obj) 
            (= 0 (vlax-get obj 'Type))) 
        (BreakClosedPline) 
        T 
      ) 
      ;open 3D pline 
      ((and (= typ "AcDb3dPolyline") 
            (not (vlax-curve-isClosed obj)) 
            (= 0 (vlax-get obj 'Type))) 
        (BreakOpen3DPline) 
        T 
      ) 
      ;closed 3D pline 
      ((and (= typ "AcDb3dPolyline") 
            (vlax-curve-isClosed obj) 
            (= 0 (vlax-get obj 'Type))) 
        (BreakClosed3DPline) 
        T 
      ) 
    ) ;cond 
 
    ;Return: new or modified or deleted object, otherwise nil. 
    ;See additional notes at BreakRay and BreakXline sub-functions. 
    (cond 
      ;obj was erased, return the obj - added cond 5/15/2006 
      ((vlax-erased-p obj) (setq res obj)) 
      ;new vla-object if one was created 
      ;((/= spacecnt (vlax-get space 'Count)) ;revised 
      ((< spacecnt (vlax-get space 'Count)) 
        ;Special cond for rays: if a line was added, return the modified ray. 
        ;If a line wasn't added, the next cond returns the modified ray 
        ;given its start point changed. 
        (if (= typ "AcDbRay") 
          (setq res obj) 
          (setq res (vla-item space spacecnt)) 
        ) 
      ) 
      ;or modified vla-object 
      ((or 
        (and startpt 
          (not (equal (DelZ startpt) (DelZ (vlax-curve-getStartPoint obj)) 1e-12))) 
        (and endpt 
          (not (equal (DelZ endpt) (DelZ (vlax-curve-getEndPoint obj)) 1e-12))) 
       ) 
       (setq res obj) 
      ) 
    )    
  ) ;and 
  res   
) ;end BreakMethod

eachy · 发表于 2013-11-29 23:52:39

xshrimp 发表于 2013-11-29 23:11
用非command打断可以参考
BreakMethod v2.0.lsp

这就没必要了，我写的那个选择集交点断开都有
上面的就是要用 Bread 命令，简单化

fjb54007 · 发表于 2014-11-14 21:54:01

正需要，谢谢楼主分享

xvjiex · 发表于 2021-7-26 00:08:09

感谢楼主分享her

hh_lj007 · 发表于 2021-7-26 00:36:26

感谢分享源码

chen7560152 · 发表于 2021-7-28 23:56:36

很给力的小功能

账号		自动登录	找回密码
密码			立即注册

[每日一码] 改造一下打断于点

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评

点评