请高手帮忙看看
怎样融合这两个lisp命令为一个？使用交点打断时，自动先打断多段线。即交点打断包含多段线。1.多段线打断：
;;;选择的pline线在端点处全部断开.
(defun c:bb (/ ss i en) ;_定义命令名 2006/10/14 师兄
(defun bb1 (e / bg ed no p10 pl pl10 plist pltype pt1 pt2)
(defun GETPLVTX (E / ED)
(defun DXF (NO)
(cdr (assoc NO ED))
) ;end defun
(defun GETLWPL (ED / pl pl10)
(while
(setq ED (cdr (member (setq PL10 (assoc 10 ED)) ED)))
(setq PL (cons (cdr PL10) PL))
)
(reverse PL)
) ;end defun
(defun GETPL (ED / e p10 pl)
(setq E (DXF -1))
(while
(setq E (entnext E))
(if
(setq P10 (cdr (assoc 10 (entget E))))
(setq PL (cons P10 PL))
) ;end if
) ;end while
(reverse PL)
) ;end defun
(setq ED (entget E))
(setq PLTYPE (DXF 0))
(cond
((= "POLYLINE" PLTYPE)
(GETPL ED)
)
((= "LWPOLYLINE" PLTYPE)
(GETLWPL ED)
)
)
)
;;下边为了适应多个对象,这行注释,并将e作为此函数的参数
;;; (setq e (car (entsel "选择要断开全部端点的多线段? ")))
(setq ED (entget E))
;(setq pw (cdr (assoc 41 ED)))
;(setvar "plinewid" Pw)
(setq bg T)
(setq plist (GETPLVTX e))
;(command "erase" e "")
(while (or bg (and pt1 pt2))
(if (= bg T)
(setq bg nil)
(progn (command "break" e pt2 "@")
(setq e (entlast))
)
)
(setq pt1 (car plist))
(setq plist (cdr plist))
(setq pt2 (car plist))
)
)
;;;下边是师兄加的部份
(princ "\n选择要全部断开端点的多段：") ;_提示用户
(setq ss (ssget)) ;_构建选择集 SS
(setq i '0) ;_步进初值 0
(if (= (type ss) 'PICKSET) ;_判断选择集有效性
(repeat (sslength ss) ;_循环选择集中每一个对象
(setq en (ssname ss i) ;_本次循环要处理的图元
i(1+ i) ;_下一图元的选择集索引加1
)
(bb1 en) ;_运行打断程序
)
)
(princ);_静默退出
)
2.交点打断：
;;;=======================[ BreakObjects.lsp ]==============================
;;; Author: Copyright?2006,2007 Charles Alan Butler
;;; Contact @www.TheSwamp.org
;;; Version:1.3 April 9,2007
;;; Globalization by XANADU - www.xanadu.cz
;;; Purpose: Break All selected objects
;;; permitted objects are lines, lwplines, plines, splines,
;;; ellipse, circles & arcs
;;;
;;;Functionc:BreakAll - Break all objects selected
;;;Functionc:BreakwObjects - Break many objects with a single object
;;;Functionc:BreakObject - Break a single object with many objects
;;;Functionc:BreakWith - Break selected objects with other selected objects
;;;Functionc:BreakTouching - Break objects touching the single Break object
;;;Functionc:BreakSelected - Break selected objects with anyobjects that touch it
;;;
;;; Sub_Routines:
;;; break_with
;;; ssget->vla-list
;;; list->3pair
;;; onlockedlayer
;;; get_interpts Return a list of intersect points
;;; break_objBreak entity at break points in list
;;; Requirements: objects must have the same z-value
;;; Restrictions: Does not Break objects on locked layers
;;; Returns:none
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY.ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;;You are hereby granted permission to use, copy and modify this ;
;;;software without charge, provided you do so exclusively for ;
;;;your own use or for use by others in your organization in the ;
;;;performance of their normal duties, and provided further that ;
;;;the above copyright notice appears in all copies and both that ;
;;;copyright notice and the limited warranty and restricted rights;
;;;notice below appear in all supporting documentation. ;
;;;=====================================================================
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; M A I N S U B R O U T I N E
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;打断对象，隔断对象，自断
(defun NBTF_break_with (ss2brk ss2brkwith self
/ cmd intpts
lst masterlist ss
ssobjs onlockedlayer
ssget->vla-list list->3pair
get_interpts break_obj
)
;; ss2brk selection set to break
;; ss2brkwith selection set to use as break points
;; self when true will allow an object to break itself
;; note that plined will break at each vertex
(vl-load-com)
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; S U B F U N C T I O N S
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(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 / i ename lst)
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(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)
)
;;==============================================================
;;return a list of intersect points
;;==============================================================
(defun get_interpts (obj1 obj2 / iplist)
(if (not (vl-catch-all-error-p
(setq
iplist (vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-intersectwith obj1 obj2 acextendnone)
)
)
)
)
)
)
iplist
)
)
;;==============================================================
;;Break entity at break points in list
;;==============================================================
(defun break_obj (ent brkptlst / brkobjlst
en enttype maxparam closedobj
minparam obj obj2breakp1param
p2 p2param
)
(setq obj2break ent
brkobjlst (list ent)
enttype (cdr (assoc 0 (entget ent)))
)
(foreach brkpt brkptlst
;;get last entity created via break in case multiple breaks
(if brkobjlst
(progn
;;if pt not on object x, switch objects
(if (not (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj2break brkpt)
)
)
)
(foreach obj brkobjlst ; find the one that pt is on
(if (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj brkpt)
)
)
(setq obj2break obj) ; switch objects
)
)
)
)
)
;;Handle any objects that can not be used with the Break Command
;;using one point, gap of 0.000001 is used
(cond
((and (= "SPLINE" enttype) ; only closed splines
(vlax-curve-isclosed obj2break)
)
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam
obj2break
(+ p1param 0.000001)
)
)
(command "._break"
obj2break
"_non"
(trans brkpt 0 1)
"_non"
(trans p2 0 1)
)
)
((= "CIRCLE" enttype); break the circle
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2 (vlax-curve-getpointatparam
obj2break
(+ p1param 0.000001)
)
)
(command "._break"
obj2break
"_non"
(trans brkpt 0 1)
"_non"
(trans p2 0 1)
)
(setq enttype "ARC")
)
((and (= "ELLIPSE" enttype) ; only closed ellipse
(vlax-curve-isclosed obj2break)
)
;;Break the ellipse, code borrowed from Joe Burke6/6/2005
(setq p1param (vlax-curve-getparamatpoint obj2break brkpt)
p2param (+ p1param 0.000001)
minparam (min p1param p2param)
maxparam (max p1param p2param)
obj (vlax-ename->vla-object obj2break)
)
(vlax-put obj 'startparameter maxparam)
(vlax-put obj 'endparameter (+ minparam (* pi 2)))
)
;;==================================
(t ; Objects that can be broken
(setq closedobj (vlax-curve-isclosed obj2break))
(command "._break"
obj2break
"_non"
(trans brkpt 0 1)
"_non"
(trans brkpt 0 1)
)
(if (not closedobj); new object was created
(setq brkobjlst (cons (entlast) brkobjlst))
)
)
)
)
)
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;; S T A R T H E R E
;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
(if (and ss2brk ss2brkwith)
(progn
;;CREATE a list of entity & it's break points
(foreach obj (ssget->vla-list ss2brk)
; check each object in ss2brk
(if (not (onlockedlayer (vlax-vla-object->ename obj)))
(progn
(setq lst nil)
;; check for break pts with other objects in ss2brkwith
(foreach intobj (ssget->vla-list ss2brkwith)
(if (and (or self (not (equal obj intobj)))
(setq intpts (get_interpts obj intobj))
)
(setq lst (append (list->3pair intpts) lst))
; entity w/ break points
)
)
(if lst
(setq masterlist
(cons (cons (vlax-vla-object->ename obj) lst)
masterlist
)
)
)
)
)
)
;;masterlist = ((ent brkpts)(ent brkpts)...)
(if masterlist
(foreach obj2brk masterlist
(break_obj (car obj2brk) (cdr obj2brk))
)
)
)
)
;;==============================================================
)
;;==========================================
;; Break all objects selected
;;==========================================
(defun c:breakall (/ cmd ss)
(command "._undo" "_begin")
(setq cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;;get objects to break
(prompt "\n选择需要打断的对象: ")
(if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(NBTF_break_with ss ss nil); ss2break ss2breakwith (flag nil = not to break with self)
)
(setvar "CMDECHO" cmd)
(command "._undo" "_end")
(princ)
)
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
;; E n d O f F i l e I f y o u A r e H e r e
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
这个好像很厉害，可能是论坛交点打断目前最好的源码了吧。
页:
[1]