lisp chặt rời các đối tượng làm hai phần

[trieubb 5]

Em cần gấp chặt rời các đối tượng ra làm hai phần;

Bác nào có cái lisp chặt rời các đối tượng làm hai phần, tức là (_break at point) ấy

Ví dụ em muốn chặt đường 1 mà có đường 2 cắt qua nó em

se làm như sau:

gõ lệnh, sau đó chọn đối tượng cần chặt (tức đường 1) rồi Enter cái, rồi chọn đường để chặt (tức đường 2)

rồi Enter thế là đường 1 bị chặt ra làm hai phần

các bác ơi cái này mỗi ngày em làm mấy ngìn đường đấy bác ạ, mà em cứ ngồi chặt thủ công mãi chán quá rồi

các bác giúp em nhanh với

em cảm ơn các bác nhiều

[be_chanh 894]

hãy search trên diễn đàn với từ khóa "c:bf"

 

http://www.google.com.vn/search?q=c%3Abf+s...lient=firefox-a

[trieubb 5]

hãy search trên diễn đàn với từ khóa "c:bf"

 

http://www.google.com.vn/search?q=c%3Abf+s...lient=firefox-a

 

 

Bác ơi, cái này thì em biết rồi.

cái này em cứ đi chấm từng điểm một em mỏi tay lắm

cái em bảo là thay bằng cách nhập điểm thì khai nó bằng

đường 2 cắt qua nó cơ

bác giúp em với

em thanks các bác trước nhé!

[traitimsat034 15]

Bác ơi, cái này thì em biết rồi.

cái này em cứ đi chấm từng điểm một em mỏi tay lắm

cái em bảo là thay bằng cách nhập điểm thì khai nó bằng

đường 2 cắt qua nó cơ

bác giúp em với

em thanks các bác trước nhé!

Mình có sưu tập được một lisp giống với yêu cầu của bạn, hi vọng giúp ích cho bạn.

 

;;;=======================[ 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

;;;

;;; Function c:BreakAll - Break all objects selected

;;; Function c:BreakwObjects - Break many objects with a single object

;;; Function c:BreakObject - Break a single object with many objects

;;; Function c:BreakWith - Break selected objects with other selected objects

;;; Function c:BreakTouching - Break objects touching the single Break object

;;; Function c:BreakSelected - Break selected objects with any objects that touch it

;;;

;;; Sub_Routines:

;;; break_with

;;; ssget->vla-list

;;; list->3pair

;;; onlockedlayer

;;; get_interpts Return a list of intersect points

;;; break_obj Break 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 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 obj2break p1param 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 Burke 6/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))

)

)

)

)

;;==============================================================

 

)

(prompt "\nBreak Routines Loaded, Enter BreakAll, BreakEnt, or BreakWith to run.")

(princ)

 

 

 

;;==========================================

;; Break all objects selected

;;==========================================

(defun c:Breakall (/ cmd ss)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect All objects to break & press enter: ")

(if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(Break_with ss ss nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

 

;;==========================================

;; Break a single object with many objects

;;==========================================

(defun c:BreakObject (/ cmd ss1 ss2)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect single object to break: ")

(if (and (setq ss1 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (redraw (ssname ss1 0) 3))

(not (prompt "\n*** Select object(s) to break with & press enter: ***"))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (redraw (ssname ss1 0) 4)))

(Break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

;;==========================================

;; Break many objects with a single object

;;==========================================

(defun c:breakwobjects (/ cmd ss1 ss2)

(defun ssredraw (ss mode / i num)

(setq i -1)

(while (setq ename (ssname ss (setq i (1+ i))))

(redraw (ssname ss i) mode)

)

)

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect object(s) to break & press enter: ")

(if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 3))

(not (prompt "\n*** Select single object to break with: ***"))

(setq ss2 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 4))

)

(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

;;==========================================

;; Break many objects with many object

;;==========================================

(defun c:BreakWith (/ cmd ss1 ss2)

(defun ssredraw (ss mode / i num)

(setq i -1)

(while (setq ename (ssname ss (setq i (1+ i))))

(redraw (ssname ss i) mode)

)

)

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect object(s) to break & press enter: ")

(if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 3))

(not (prompt "\n*** Select object(s) to break with & press enter: ***"))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 4))

)

(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

 

 

;;=============================================

;; Break many objects with a selected objects

;; Selected Objects create ss to be broken

;;=============================================

 

(defun c:BreakTouching (/ cmd ss1 ss2)

 

;; get all objects touching entities in the sscross

;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"

(defun gettouching (sscros / ss lst lstb lstc objl)

(and

(setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))

objl (mapcar 'vlax-ename->vla-object lstb)

)

(setq

ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")

(cons 410 (getvar "ctab"))))

)

(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(setq lst (mapcar 'vlax-ename->vla-object lst))

(mapcar

'(lambda (x)

(mapcar

'(lambda (y)

(if (not

(vl-catch-all-error-p

(vl-catch-all-apply

'(lambda ()

(vlax-safearray->list

(vlax-variant-value

(vla-intersectwith y x acextendnone)

))))))

(setq lstc (cons (vlax-vla-object->ename x) lstc))

)

) objl)

) lst)

)

lstc

)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(setq ss1 (ssadd))

;; get objects to break

(if (and (not (prompt "\nSelect object(s) to break with & press enter: "))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))

)

(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

 

 

;;==========================================================

;; Break selected objects with any objects that touch it

;;==========================================================

 

 

(defun c:BreakSelected (/ cmd ss1 ss2)

 

;; get all objects touching entities in the sscross

;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"

(defun gettouching (sscros / ss lst lstb lstc objl)

(and

(setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))

objl (mapcar 'vlax-ename->vla-object lstb)

)

(setq

ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")

(cons 410 (getvar "ctab"))))

)

(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(setq lst (mapcar 'vlax-ename->vla-object lst))

(mapcar

'(lambda (x)

(mapcar

'(lambda (y)

(if (not

(vl-catch-all-error-p

(vl-catch-all-apply

'(lambda ()

(vlax-safearray->list

(vlax-variant-value

(vla-intersectwith y x acextendnone)

))))))

(setq lstc (cons (vlax-vla-object->ename x) lstc))

)

) objl)

) lst)

)

lstc

)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(setq ss1 (ssadd))

;; get objects to break

(if (and (not (prompt "\nSelect object(s) to break with & press enter: "))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))

)

(break_with ss2 ss1 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

;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.

[Phidoi_gabay 14]

Bác ơi, cái này thì em biết rồi.

cái này em cứ đi chấm từng điểm một em mỏi tay lắm

cái em bảo là thay bằng cách nhập điểm thì khai nó bằng

đường 2 cắt qua nó cơ

bác giúp em với

em thanks các bác trước nhé!

Bạn dung cài này xem nhé. Lệnh BB

(defun c:bb () (command "break" pause "f" pause "@"))

;CIRCLE

[trieubb 5]

Mình có sưu tập được một lisp giống với yêu cầu của bạn, hi vọng giúp ích cho bạn.

 

;;;=======================[ 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

;;;

;;; Function c:BreakAll - Break all objects selected

;;; Function c:BreakwObjects - Break many objects with a single object

;;; Function c:BreakObject - Break a single object with many objects

;;; Function c:BreakWith - Break selected objects with other selected objects

;;; Function c:BreakTouching - Break objects touching the single Break object

;;; Function c:BreakSelected - Break selected objects with any objects that touch it

;;;

;;; Sub_Routines:

;;; break_with

;;; ssget->vla-list

;;; list->3pair

;;; onlockedlayer

;;; get_interpts Return a list of intersect points

;;; break_obj Break 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 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 obj2break p1param 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 Burke 6/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))

)

)

)

)

;;==============================================================

 

)

(prompt "\nBreak Routines Loaded, Enter BreakAll, BreakEnt, or BreakWith to run.")

(princ)

 

 

 

;;==========================================

;; Break all objects selected

;;==========================================

(defun c:Breakall (/ cmd ss)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect All objects to break & press enter: ")

(if (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(Break_with ss ss nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

 

;;==========================================

;; Break a single object with many objects

;;==========================================

(defun c:BreakObject (/ cmd ss1 ss2)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect single object to break: ")

(if (and (setq ss1 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (redraw (ssname ss1 0) 3))

(not (prompt "\n*** Select object(s) to break with & press enter: ***"))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (redraw (ssname ss1 0) 4)))

(Break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

;;==========================================

;; Break many objects with a single object

;;==========================================

(defun c:breakwobjects (/ cmd ss1 ss2)

(defun ssredraw (ss mode / i num)

(setq i -1)

(while (setq ename (ssname ss (setq i (1+ i))))

(redraw (ssname ss i) mode)

)

)

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect object(s) to break & press enter: ")

(if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 3))

(not (prompt "\n*** Select single object to break with: ***"))

(setq ss2 (ssget "+.:E:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 4))

)

(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

;;==========================================

;; Break many objects with many object

;;==========================================

(defun c:BreakWith (/ cmd ss1 ss2)

(defun ssredraw (ss mode / i num)

(setq i -1)

(while (setq ename (ssname ss (setq i (1+ i))))

(redraw (ssname ss i) mode)

)

)

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

 

;; get objects to break

(prompt "\nSelect object(s) to break & press enter: ")

(if (and (setq ss1 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 3))

(not (prompt "\n*** Select object(s) to break with & press enter: ***"))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(not (ssredraw ss1 4))

)

(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

 

 

;;=============================================

;; Break many objects with a selected objects

;; Selected Objects create ss to be broken

;;=============================================

 

(defun c:BreakTouching (/ cmd ss1 ss2)

 

;; get all objects touching entities in the sscross

;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"

(defun gettouching (sscros / ss lst lstb lstc objl)

(and

(setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))

objl (mapcar 'vlax-ename->vla-object lstb)

)

(setq

ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")

(cons 410 (getvar "ctab"))))

)

(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(setq lst (mapcar 'vlax-ename->vla-object lst))

(mapcar

'(lambda (x)

(mapcar

'(lambda (y)

(if (not

(vl-catch-all-error-p

(vl-catch-all-apply

'(lambda ()

(vlax-safearray->list

(vlax-variant-value

(vla-intersectwith y x acextendnone)

))))))

(setq lstc (cons (vlax-vla-object->ename x) lstc))

)

) objl)

) lst)

)

lstc

)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(setq ss1 (ssadd))

;; get objects to break

(if (and (not (prompt "\nSelect object(s) to break with & press enter: "))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))

)

(break_with ss1 ss2 nil) ; ss2break ss2breakwith (flag nil = not to break with self)

)

 

(setvar "CMDECHO" cmd)

(command "._undo" "_end")

(princ)

)

 

 

 

;;==========================================================

;; Break selected objects with any objects that touch it

;;==========================================================

 

 

(defun c:BreakSelected (/ cmd ss1 ss2)

 

;; get all objects touching entities in the sscross

;; limited obj types to "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"

(defun gettouching (sscros / ss lst lstb lstc objl)

(and

(setq lstb (vl-remove-if 'listp (mapcar 'cadr (ssnamex sscros)))

objl (mapcar 'vlax-ename->vla-object lstb)

)

(setq

ss (ssget "_A" (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")

(cons 410 (getvar "ctab"))))

)

(setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))

(setq lst (mapcar 'vlax-ename->vla-object lst))

(mapcar

'(lambda (x)

(mapcar

'(lambda (y)

(if (not

(vl-catch-all-error-p

(vl-catch-all-apply

'(lambda ()

(vlax-safearray->list

(vlax-variant-value

(vla-intersectwith y x acextendnone)

))))))

(setq lstc (cons (vlax-vla-object->ename x) lstc))

)

) objl)

) lst)

)

lstc

)

 

(command "._undo" "_begin")

(setq cmd (getvar "CMDECHO"))

(setvar "CMDECHO" 0)

(setq ss1 (ssadd))

;; get objects to break

(if (and (not (prompt "\nSelect object(s) to break with & press enter: "))

(setq ss2 (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

(mapcar '(lambda (x) (ssadd x ss1)) (gettouching ss2))

)

(break_with ss2 ss1 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

;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.

 

 

 

 

cảm on các bác nhưng các cái các bác đưa vẫn chưa đúng ý của em

nên vẫn không giải quyết được gì cả các bác ạ

em cảm ơn các bác nhiều

[trieubb 5]

ồ cảm ơn bác nhưng cái này vẫn chưa đúng ý của mình

cái này vẫn phải bắt điểm chặt mà

ý mình là thay bằng bắt điểm chặt thì ta chọn đường thứ 2

cắt nó là nó sẽ chặt qua điểm chúng giao nhau cơ

[nataca 554]

ồ cảm ơn bác nhưng cái này vẫn chưa đúng ý của mình

cái này vẫn phải bắt điểm chặt mà

ý mình là thay bằng bắt điểm chặt thì ta chọn đường thứ 2

cắt nó là nó sẽ chặt qua điểm chúng giao nhau cơ

Thực ra cậu có thể sửa 1 chút lisp trên để được như ý muốn thôi mà. Thôi được rồi để tôi sửa giúp cậu. Cái này tôi sửa 1 chút từ lisp của bác NguyenHoanh và Phidoi_gabay. Đoạn lisp này hiện tại chỉ đúng với đường thẳng và đường cung tròn. Còn với đường tròn và đa tuyến thì chưa đạt yêu cầu. Mọi người hoàn thiện nốt nhé

(defun c:Boj ()
  	(setq ent1 (car (setq ent (entsel "\nVao doi tuong can cat: "))))
 	(redraw ent1 3)
 	(setq ent2 (car (entsel "\nVao doi tuong dung de cat: ")))
 	(redraw ent1 4)
 	(setq giao (giaodt ent1 ent2))
 	(if giao
   		(foreach pp	giao
      			(command "break" ent "f" pp "@")
   		)
  	(alert "2 doi tuong khong giao nhau!")
 	)
 	(princ)
)
(defun GiaoDT	(ent1 ent2)
   		(setq 	ob1 (vlax-ename->vla-object ent1)
  		ob2 (vlax-ename->vla-object ent2)
   		)
   	(setq 	g 	(vlax-variant-value
      			(vla-IntersectWith ob1 ob2 acExtendNone)
    		)
   	)
   	(if	(/= (vlax-safearray-get-u-bound g 1) -1)
     		(setq g (vlax-safearray->list g))
     		(setq g nil)
   	)
   	(if	g
     		(progn
		(setq 	kq nil
      			sd (fix (/ (length g) 3))
		)
		(repeat	sd
  			(setq	kq (append kq (list (list (car g) (cadr g) (caddr g))))
				g  (cdddr g)
  			)
		)
		kq
     		)
     		nil
   	)
)

[trieubb 5]

Cái này cũng hay nhưng có cách nào chọn được nhiều đối tượng không bác