Jump to content

Single touch and break the intersection line/polyline

nalsur8

By nalsur8
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

nalsur8 Contributor

nalsur8

Posted
Posted

Hi,

 

POLY.JPG

 

Single touch and break the intersection line/polyline

 

i try create with this one, but it's seem like not corret

 

(setq epoly(entsel))
  (setq PIKPT (cadr EPOLY))
   (setq  ENXT (entnext (car EPOLY)))
    (setq LST (entget ENXT))
     (setq P1 (cdr(assoc 10 LST)))
     (setq ENXT (entnext ENXT))
     (setq LST (entget ENXT))
     (setq P2 (cdr(assoc 10 LST)))
 (command "break" p1 p1)
 (command "break" p2 p2)

MSasu Grand Master

MSasu

Posted
Posted

Not sure that I fully understand your sketch, but I believe that you can solve that very easy using the built-in command TRIM. Just press at the first prompter (cutting edges selection) and next select the part you want to remove.

nalsur8 Contributor

nalsur8

Posted
  • Author
Posted

hi,

 

i don't want to delete or remove the picked line, i just want break the point, so later i can change the remain line to hidden or change color, if use trim command the picked line will gone

Alejandros85 Newbie

Alejandros85

Posted
Posted

Hi nalsur8, try this code:

 

(DEFUN C:B1 ()
 (PROMPT "\nBreak Point")
 (TERPRI)
 (setq obj nil)
 (while (null obj)
   (setq obj (entsel "\nSelect object to break: "))
 )
 (redraw (car obj) 3)
 (initget 1)
 (setq point (getpoint "\nBreak point : "))
 (COMMAND "_.BREAK" obj "_F" point point)
 (PRINC)
)

 

And sorry for my english, i am from Costa Rica.

 

regards

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

Here, I've modified CAB's code... See if this can help you...

 

;;;=====================[ BreakObject.lsp ]=============================
;;; Author: Copyright© 2006-2012 Charles Alan Butler 
;;; Contact @  www.TheSwamp.org    
;;;   http://www.theswamp.org/index.php?topic=10370.0
;;; Version:  2.2  July 28, 2012
;;;=====================================================================
;;;   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.              ;
;;;=====================================================================

(defun gn ( l n / f )
 (defun f ( a b )
   (if (and a (< 0 b))
     (cons (car a) (f (setq l (cdr a)) (1- b)))
   )
 )
 (if l (cons (f l n) (gn l n)))
)

(defun getcltouching (sscros pt / ss lst lstb lstc objl intpt intpts)
 (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"))))
   )
   (ssdel (ssname sscros 0) ss)
   (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
                     (setq intpt (vl-catch-all-apply
                       '(lambda ()
                          (vlax-safearray->list
                            (vlax-variant-value
                              (vla-intersectwith y x acextendnone)
                            )))))))
               (progn
                 (setq intpts (gn intpt 3))
                 (foreach ipt intpts
                   (setq lstc (cons (cons (vlax-vla-object->ename x) (list ipt)) lstc))
                 )
               )
             )
           ) objl)
      ) lst)
 )
 (setq lstc (vl-sort lstc '(lambda (a b) (< (distance pt (cadr a)) (distance pt (cadr b))))))
 (setq intpts (list (cadar lstc) (cadadr lstc)))
 intpts
)

(defun c:B2 (/ cmd ss1 ss2 pt touch) (vl-load-com)
 
 (command "_.undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq ss1 (ssadd))

 (if (and (not (prompt "\nSelect object to break with touching & press enter: "))
          (setq ss2 (ssget "_+.:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (setq pt (cadr(cadddr(car (ssnamex ss2 0)))))
          (setq touch (getcltouching ss2 pt))
     )
     (progn
       (command "_.break" pt "F" (car touch) (car touch))
       (command "_.break" pt "F" (cadr touch) (cadr touch))
     )
 )
 (setvar "CMDECHO" cmd)
 (command "_.undo" "_end")
 (princ)
)

(prompt "\nEnter B2 to run.")
(princ)
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
;;    E n d   O f   F i l e   I f   y o u   A r e   H e r e       
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.

M.R.

B2.LSP

Edited by marko_ribar
marko_ribar Veteran

marko_ribar

Posted
Posted

Sorry for my late update; code changed - I think that now it suits your needs...

 

M.R.;)

nalsur8 Contributor

nalsur8

Posted
  • Author
Posted

Alenjandros85,

 

Thank for your code, it's usefull too.. but it's not what i mean

 

marko_ribar,

 

Thank the code it's what i mean and thank again to modify the code

for me

Dadgad Grand Master

Dadgad

Posted
Posted

It seems like your problem has already been solved, :beer:

but your question reminded me of a good tip from Lynn Allen

about speeding up your break command. One which i have implemented and which I like very much.

This will enable you to create a single break point, the location of which is specified

by the location of your first click, done.

 

Thanks Lynn! :D

  • Like 1
nod684 Rising Star

nod684

Posted
Posted

try this : it will enable you to select a line and ask you for breaking point. Osnap is automatically set at intersection

 

(defun C:BKI (/ ln pt1) ;;break at intersection
(setq osm (getvar 'osmode)) 
(setq cmd1 (getvar 'cmdecho))
(setvar 'cmdecho 0) 
(setvar 'osmode 32) 
(setq ln (entsel "\nChoose Line to Break...")) 
(setq pt1 (getpoint "\nPick Break Point.. ")) 
(command "break" ln "f" pt1 "@") 
(setvar 'osmode osm) 
(setvar 'cmdecho cmd1) 
(princ) 
)

marko_ribar Veteran

marko_ribar

Posted
Posted (edited)

My apology, one more revision :

 

;;;=====================[ BreakObject.lsp ]=============================
;;; Author: Copyright© 2006-2012 Charles Alan Butler 
;;; Contact @  www.TheSwamp.org    
;;;   http://www.theswamp.org/index.php?topic=10370.0
;;; Version:  2.2  July 28, 2012
;;;=====================================================================
;;;   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.              ;
;;;=====================================================================

(defun prelst ( l i / n r )
 (while (and (setq n (car l)) (not (equal n i 1e-))
   (setq r (cons n r) l (cdr l))
 )
 (reverse r)
)

(defun sufflst ( l i / n r c )
 (setq l (reverse l) c (length l))
 (while (and (setq n (car l)) (not (equal n i 1e-))
   (setq r (cons n r) l (cdr l))
 )
 (if (/= (length r) c) r)
)

(defun gn ( l n / f )
 (defun f ( a b )
   (if (and a (< 0 b))
     (cons (car a) (f (setq l (cdr a)) (1- b)))
   )
 )
 (if l (cons (f l n) (gn l n)))
)

(defun getcltouching (sscros pt / ss lst lstb lstc objl intpt intpt1 intpt2 intpts)
 (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"))))
   )
   (ssdel (ssname sscros 0) ss)
   (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
                     (setq intpt (vl-catch-all-apply
                       '(lambda ()
                          (vlax-safearray->list
                            (vlax-variant-value
                              (vla-intersectwith y x acextendnone)
                            )))))))
               (progn
                 (setq intpts (gn intpt 3))
                 (foreach ipt intpts
                   (setq lstc (cons (cons (vlax-curve-getparamatpoint y ipt) (list ipt)) lstc))
                 )
               )
             )
           ) objl)
      ) lst)
 )
 (setq lstc (cons (cons (vlax-curve-getparamatpoint (car objl) (setq pt (vlax-curve-getclosestpointto (car objl) pt))) (list pt)) lstc))
 (setq lstc (vl-sort lstc '(lambda (a b) (< (car a) (car b)))))
 (setq lstc (mapcar 'cadr lstc))
 (setq intpt1 (last (prelst lstc pt)))
 (setq intpt2 (car (sufflst lstc pt)))
 (setq intpts (list intpt1 intpt2))
 intpts
)

(defun c:B2 (/ cmd ss1 ss2 pt touch) (vl-load-com)
 
 (command "_.undo" "_begin")
 (setq cmd (getvar "CMDECHO"))
 (setvar "CMDECHO" 0)
 (setq ss1 (ssadd))

 (if (and (not (prompt "\nSelect object to break with touching"))
          (setq ss2 (ssget "_+.:S" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
          (setq pt (cadr(cadddr(car (ssnamex ss2 0)))))
          (setq pt (vlax-curve-getclosestpointto (ssname ss2 0) pt))
          (setq touch (getcltouching ss2 pt))
     )
     (progn
       (command "_.break" (car (nentselp pt)) (car touch) (car touch))
       (command "_.break" (car (nentselp pt)) (cadr touch) (cadr touch))
     )
 )
 (setvar "CMDECHO" cmd)
 (command "_.undo" "_end")
 (princ)
)

(prompt "\nEnter B2 to run.")
(princ)
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.
;;    E n d   O f   F i l e   I f   y o u   A r e   H e r e       
;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\.

M.R.

B2.LSP

Edited by marko_ribar
code changed to work also in older versions A2008, A2009
marko_ribar Veteran

marko_ribar

Posted
Posted

Only recently I've noticed that code didn't work properly in older versions of AutoCAD - now tested on A2008, A2009...

 

So B2.lsp is again updated to be used and on older versions of AutoCAD...

 

Sincerely, regards M.R.

nalsur8 Contributor

nalsur8

Posted
  • Author
Posted

Marko Ribar, TQ

 

tested with acad2002 with no problem,

i just add code for *error* trap when user press ESC

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...