Jump to content

Break an object at 2 points and replace the properties of the line

Nikon

By Nikon
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

GLAVCVS Experienced

GLAVCVS

Posted
Posted
On 9/11/2025 at 8:31 AM, Nikon said:

Thank
The code works perfectly for straight sections. For circles and arcs, I would like to simply change the properties of the lines between points pt1 and pt2. 
There is no need to connect these points with a straight line.

 

 

I think I read your first explanation too quickly.

I also thought about keeping the main part of your code to avoid overcomplicating my answer.
But in the end, I decided to spend a little time improving the code.

 

Here's another option for doing this task.

One possible difference (or not) with the other options discussed in this thread is that the cut points may or may not be on the object to be cut: when they aren't, it will calculate the perpendicular point.

Another small difference is that here, you're still required to first select the object to be modified to avoid the problem of cases where several objects coincide at the same point.

  

(defun c:Br2ptReplDash (/ para	  tl	  ss	  pt1	  pt2
			  p1	  p2	  ent	  vlae	  ep
			  to	  c	  r	  eumk	  entdata
			  newent  entUlt  osmant  ecoA	  lstChg
			  lstR	  lent1	  lent	  pIni	  pFin
			  dameSeg *troca* erroria errores error0
			 )
  (defun erroria ()
    (defun errores (mens)
      (setq *error* error0)
      (command-s "._undo" "_1")
      (prin1)
    )
    (setq error0  *error*
	  *error* errores
    )
  )
  (defun dameSeg (e p1 p2 / vlae pIni pFin rg)
    (setq pIni (vlax-curve-getPointatParam (setq vlae (vlax-ename->vla-object e)) (vlax-curve-getStartParam vlae))
	  pFin (vlax-curve-getPointatParam vlae (vlax-curve-getEndParam vlae))
	  rg (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) 1.01)
    )
    (if (and (or
	       (equal p1 pIni rg)
	       (equal p1 pFin rg)
	     )
	     (or
	       (equal p2 pIni rg)
	       (equal p2 pFin rg)
	     )
	)
      T
    )
  )
  (defun grreadea (/ para lr )
    (while (not para)
      (princ "\rPress TAB to switch modifications, Select next object to split or RIGHT CLICK to EXIT...")
      (setq lr (grread T 4 2))
      (cond
	((= (car lr) 2)
	 (cond
	   ((= (cadr lr) 9)
	    (setq *troca* (not *troca*))
	    (entmod (append (if *troca* lent lent1) lstChg))
	    (entmod (append (if *troca* lent1 lent) lstR))
	   )
	 )
        )
	((= (car lr) 25) (setq para 0 ep nil) )
	((= (car lr) 3)
	 (if (listp (cadr lr))
	   (setq ep (nentselp (cadr lr))
		 ep (if (wcmatch (cdr (assoc 0 (entget (car ep)))) "*LINE,ARC,CIRCLE") ep)
		 para (if ep T)
	   )
	 )
        )
	(T (if (/= (car lr) 5) (print lr) ))
      )	 
    )
    para
  )
  
  (erroria)
  (setq	osmant (getvar "OSMODE")
	ecoA (getvar "CMDECHO")
	eumk nil
	tl "DASHED2"
	tl (if (tblsearch "LTYPE" tl)
	     tl
	     (progn
	       (vlr-beep-reaction)
	       (alert (princ (strcat "\n*** Linetype " tl " not found. It will be instead CONTINUOUS")))
	       "CONTINUOUS"
	     )
	   )
	lstChg (list
		 '(8 . "0")	; the default layer
		 (cons 6 tl)	; line type
		 '(48 . 0.25)	; thickness
		 '(62 . 84)     ; color
		)
  )
  (setvar "CMDECHO" 0)
  (while (and
	   (not para)
	   (or ep
             (setq ss (SETVAR "NOMUTT" 1)
	           ss (princ "\nSelect object to trim (RIGH CLICK to EXIT)...")
	           ss (ssget "_+.:E:S" '((0 . "*LINE,POLYLINE,CIRCLE,ARC")))
	     )
	   )
	 )
    (SETVAR "NOMUTT" 0)
    (setq entUlt (entlast))
    (princ "\nSelect the object to split...")
    (setq ent (if ep (car ep) (ssname ss 0))
	  lstR (list
		 (cons 6 (if (assoc 6 (entget ent)) (cdr (assoc 6 (entget ent))) "BYLAYER"))
		 (cons 48 (if (assoc 48 (entget ent)) (cdr (assoc 48 (entget ent))) 1.0))
		 (cons 62 (if (assoc 62 (entget ent)) (cdr (assoc 62 (entget ent))) 256))
	       )
    )
      
    (setq pt1 (getpoint "\nSelect the first break point: ") ;; Entering the first break point
	  pt2 (getpoint "\nSelect the second break point: ") ;; Entering the second break point
	  ep nil
    )
    (vla-startUndomark (vla-get-activeDocument (vlax-get-acad-object)))
      ;; Checking the object type and performing the split
    (cond
      ((wcmatch (setq to (cdr (assoc 0 (entget ent)))) "*LINE")
	 ;; break polyline
       (setq pt1 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) pt1)
	     pt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) pt2)
       )
       (command "_.BREAK" ent pt1 pt2)
       (command "_.LINE" pt1 pt2 "")
       (entmod (append (ENTGET (ENTLAST)) lstChg))
      )

      ((= to "CIRCLE")
	 ;; break the circle
       (setvar "OSMODE" 0)
       (entmake (entget ent))
       (command "_.BREAK" ent pt1 pt2)
       (command "_.BREAK" (entlast) pt2 pt1)
       (setq lent (entget ent))
       (entmod (append (setq lent1 (entget (entlast))) lstChg))
       (setq para (= 0 (grreadea)))
      )
      
      ((= to "ARC")
	 ;; break the arc
       (setvar "OSMODE" 0)
       (setq ;ent1 (entmake (entget ent))
	     pIni (vlax-curve-getPointatParam (setq vlae (vlax-ename->vla-object ent)) (vlax-curve-getStartParam vlae))
	     pFin (vlax-curve-getPointatParam vlae (vlax-curve-getEndParam vlae))
	     pt1 (polar (setq c (cdr (assoc 10 (setq lent (entget ent))))) (angle c pt1) (setq r (cdr (assoc 40 lent))))
	     pt2 (polar c (angle c pt2) r)
       )
       (command "_.BREAK" ent pt1 pt1)
       (if (equal (car (nentselp pt2)) (setq ent1 (entlast))); SI P2 EST脕 SOBRE LA NUEVA ENTIDAD CREADA
	 (command "_.BREAK" ent1 pt2 pt2)
	 (command "_.BREAK" ent pt2 pt2)
       )
       (entmod (append (entget (if (dameSeg (setq ent2 (entlast)) pt1 pt2) ent2 ent1)) lstChg))
      )
      (T
       (prompt "An object of an unsupported type.")
      )
    )
    (vla-EndUndomark (vla-get-activeDocument (vlax-get-acad-object)))
    (setq eumk T)
    (setvar "OSMODE" OSMANT)
  )
  (if ecoA (setvar "CMDECHO" ecoA))
  (if (not entUlt) (princ "\nObjects are not selected."))
  (princ)
)

 

  • Like 1
  • Thanks 1
  • Replies 22
  • Created
  • Last Reply

Top Posters In This Topic

  • Nikon

    10

  • mhupp

    4

  • GLAVCVS

    4

  • BIGAL

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

mhupp
mhupp

This is a bit more streamlined. ;; AutoLISP, which allows you to select objects (line, polyline, circle, arc), ;; break them at two points and replace the selected section with a dashed line with t

mhupp
mhupp

You start the lisp with if this will only run once. changing the if to while will allow you to use the break command multiple of times with out having to type the command over and over. only draw back

BlackBox
BlackBox

Entlast & entnext may help to mitigate that.         1+ 

Posted Images

GLAVCVS Experienced

GLAVCVS

Posted
Posted
10 minutes ago, GLAVCVS said:

 

I think I read your first explanation too quickly.

I also thought about keeping the main part of your code to avoid overcomplicating my answer.
But in the end, I decided to spend a little time improving the code.

 

Here's another option for doing this task.

One possible difference (or not) with the other options discussed in this thread is that the cut points may or may not be on the object to be cut: when they aren't, it will calculate the perpendicular point.

Another small difference is that here, you're still required to first select the object to be modified to avoid the problem of cases where several objects coincide at the same point.

  

(defun c:Br2ptReplDash (/ para	  tl	  ss	  pt1	  pt2
			  p1	  p2	  ent	  vlae	  ep
			  to	  c	  r	  eumk	  entdata
			  newent  entUlt  osmant  ecoA	  lstChg
			  lstR	  lent1	  lent	  pIni	  pFin
			  dameSeg *troca* erroria errores error0
			 )
  (defun erroria ()
    (defun errores (mens)
      (setq *error* error0)
      (command-s "._undo" "_1")
      (prin1)
    )
    (setq error0  *error*
	  *error* errores
    )
  )
  (defun dameSeg (e p1 p2 / vlae pIni pFin rg)
    (setq pIni (vlax-curve-getPointatParam (setq vlae (vlax-ename->vla-object e)) (vlax-curve-getStartParam vlae))
	  pFin (vlax-curve-getPointatParam vlae (vlax-curve-getEndParam vlae))
	  rg (* (getvar "PICKBOX") (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) 1.01)
    )
    (if (and (or
	       (equal p1 pIni rg)
	       (equal p1 pFin rg)
	     )
	     (or
	       (equal p2 pIni rg)
	       (equal p2 pFin rg)
	     )
	)
      T
    )
  )
  (defun grreadea (/ para lr )
    (while (not para)
      (princ "\rPress TAB to switch modifications, Select next object to split or RIGHT CLICK to EXIT...")
      (setq lr (grread T 4 2))
      (cond
	((= (car lr) 2)
	 (cond
	   ((= (cadr lr) 9)
	    (setq *troca* (not *troca*))
	    (entmod (append (if *troca* lent lent1) lstChg))
	    (entmod (append (if *troca* lent1 lent) lstR))
	   )
	 )
        )
	((= (car lr) 25) (setq para 0 ep nil) )
	((= (car lr) 3)
	 (if (listp (cadr lr))
	   (setq ep (nentselp (cadr lr))
		 ep (if (wcmatch (cdr (assoc 0 (entget (car ep)))) "*LINE,ARC,CIRCLE") ep)
		 para (if ep T)
	   )
	 )
        )
	(T (if (/= (car lr) 5) (print lr) ))
      )	 
    )
    para
  )
  
  (erroria)
  (setq	osmant (getvar "OSMODE")
	ecoA (getvar "CMDECHO")
	eumk nil
	tl "DASHED2"
	tl (if (tblsearch "LTYPE" tl)
	     tl
	     (progn
	       (vlr-beep-reaction)
	       (alert (princ (strcat "\n*** Linetype " tl " not found. It will be instead CONTINUOUS")))
	       "CONTINUOUS"
	     )
	   )
	lstChg (list
		 '(8 . "0")	; the default layer
		 (cons 6 tl)	; line type
		 '(48 . 0.25)	; thickness
		 '(62 . 84)     ; color
		)
  )
  (setvar "CMDECHO" 0)
  (while (and
	   (not para)
	   (or ep
             (setq ss (SETVAR "NOMUTT" 1)
	           ss (princ "\nSelect object to trim (RIGH CLICK to EXIT)...")
	           ss (ssget "_+.:E:S" '((0 . "*LINE,POLYLINE,CIRCLE,ARC")))
	     )
	   )
	 )
    (SETVAR "NOMUTT" 0)
    (setq entUlt (entlast))
    (princ "\nSelect the object to split...")
    (setq ent (if ep (car ep) (ssname ss 0))
	  lstR (list
		 (cons 6 (if (assoc 6 (entget ent)) (cdr (assoc 6 (entget ent))) "BYLAYER"))
		 (cons 48 (if (assoc 48 (entget ent)) (cdr (assoc 48 (entget ent))) 1.0))
		 (cons 62 (if (assoc 62 (entget ent)) (cdr (assoc 62 (entget ent))) 256))
	       )
    )
      
    (setq pt1 (getpoint "\nSelect the first break point: ") ;; Entering the first break point
	  pt2 (getpoint "\nSelect the second break point: ") ;; Entering the second break point
	  ep nil
    )
    (vla-startUndomark (vla-get-activeDocument (vlax-get-acad-object)))
      ;; Checking the object type and performing the split
    (cond
      ((wcmatch (setq to (cdr (assoc 0 (entget ent)))) "*LINE")
	 ;; break polyline
       (setq pt1 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) pt1)
	     pt2 (vlax-curve-getClosestPointTo (vlax-ename->vla-object ent) pt2)
       )
       (command "_.BREAK" ent pt1 pt2)
       (command "_.LINE" pt1 pt2 "")
       (entmod (append (ENTGET (ENTLAST)) lstChg))
      )

      ((= to "CIRCLE")
	 ;; break the circle
       (setvar "OSMODE" 0)
       (entmake (entget ent))
       (command "_.BREAK" ent pt1 pt2)
       (command "_.BREAK" (entlast) pt2 pt1)
       (setq lent (entget ent))
       (entmod (append (setq lent1 (entget (entlast))) lstChg))
       (setq para (= 0 (grreadea)))
      )
      
      ((= to "ARC")
	 ;; break the arc
       (setvar "OSMODE" 0)
       (setq ;ent1 (entmake (entget ent))
	     pIni (vlax-curve-getPointatParam (setq vlae (vlax-ename->vla-object ent)) (vlax-curve-getStartParam vlae))
	     pFin (vlax-curve-getPointatParam vlae (vlax-curve-getEndParam vlae))
	     pt1 (polar (setq c (cdr (assoc 10 (setq lent (entget ent))))) (angle c pt1) (setq r (cdr (assoc 40 lent))))
	     pt2 (polar c (angle c pt2) r)
       )
       (command "_.BREAK" ent pt1 pt1)
       (if (equal (car (nentselp pt2)) (setq ent1 (entlast))); SI P2 EST脕 SOBRE LA NUEVA ENTIDAD CREADA
	 (command "_.BREAK" ent1 pt2 pt2)
	 (command "_.BREAK" ent pt2 pt2)
       )
       (entmod (append (entget (if (dameSeg (setq ent2 (entlast)) pt1 pt2) ent2 ent1)) lstChg))
      )
      (T
       (prompt "An object of an unsupported type.")
      )
    )
    (vla-EndUndomark (vla-get-activeDocument (vlax-get-acad-object)))
    (setq eumk T)
    (setvar "OSMODE" OSMANT)
  )
  (if ecoA (setvar "CMDECHO" ecoA))
  (if (not entUlt) (princ "\nObjects are not selected."))
  (princ)
)

 

 

Another important detail: in the circles, the resulting arc that will be modified depends on whether the cut points are indicated in a clockwise or counterclockwise direction. If they are selected in the opposite direction from what is needed to obtain the desired result, it can be immediately switched by pressing TAB key (as indicated in the command line).

  • Thanks 1
Nikon Proficient

Nikon

Posted
  • Author
Posted (edited)
9 hours ago, GLAVCVS said:

Another important detail: in the circles, the resulting arc that will be modified depends on whether the cut points are indicated in a clockwise or counterclockwise direction. If they are selected in the opposite direction from what is needed to obtain the desired result, it can be immediately switched by pressing TAB key (as indicated in the command line).

@GLAVCVS Thank you very much, as always, you are very attentive to details.

It is very convenient that the functions work in a loop and a dashed line is created immediately.

"But in the end, I decided to spend a little time improving the code".

The code has been improved by 100 percent! 💯

 

Edited by Nikon
  • Like 1

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...