Circles at the end of lines and trim around

[teknomatika]

As a challenge and variant, it also meets my tasks,

as an alternative to the trim I would serve the break option

at the points defined by the centers of the circles

[alanjt]

42 minutes ago, Tharwat said:

@alanjt If a line penetrates one of your created circles then the vla-IntersectWith will return two appended list of coordinates which will throw an error due to extra coordinates.  

 

This shouldn't happen, as I first evaluate any intersecting lines and break them.

 

8 minutes ago, teknomatika said:

@Trudy,

 

The selection option, I had already managed to solve.
It's the same.

 

(setq sel1 (ssget '((0 . "line"))))

I am grateful for the interest and help.

 

@Alan

 

Thanks for the interest.

when running your version , draws the circles but returns an error.

 

Error: AutoCAD.Application: Incorrect number of elements in SafeArray
 

 

 

 

Looking closer at your example, I see you have lines partially overlapping one another. Is this correct?

I'm sure this is what is causing the error, as I did not realize this was a circumstance.  

[teknomatika]

@alanjt

Yes. I have lines partially overlapping. 

In a way this is a recurring situation in my task.

[alanjt]

2 minutes ago, teknomatika said:

@alanjt

Yes. I have lines partially overlapping. 

In a way this is a recurring situation in my task.

So, the end result can yield lines of two different colors, on the same layer, and the same length atop one another?

[teknomatika]

@Alanjt Yes. On same or diferent layers and same or diferente length.

As I said above, for what I need, if possible it also solves an option where the lines are broken (break) at the points defined by the centers of the circles.

[alanjt]

3 minutes ago, teknomatika said:

@Alanjt Yes. On same or diferent layers and same or diferente length.

As I said above, for what I need, if possible it also solves an option where the lines are broken (break) at the points defined by the centers of the circles.

What determines how the second "partial" circle is placed when two lines overlap?

[ronjonp]

3 hours ago, teknomatika said:

 

Trudy, 

I went back to testing and in fact it didn't happen.
However, I see that when circles overlap, they are also affected by trim.
Although as it is already satisfying what I want, it would be interesting that the circles were preserved without trim.

 

Thanks for help!

 

 

 

Why do you need to trim the objects under the circle? Is this a visual thing? If so consider using a block ( or donut for that matter ) with color 255,255,255 as a mask.

[alanjt]

6 minutes ago, ronjonp said:

Why do you need to trim the objects under the circle? Is this a visual thing? If so consider using a block ( or donut for that matter ) with color 255,255,255 as a mask.

Here's someone using their head.

[teknomatika]

25 minutes ago, ronjonp said:

Why do you need to trim the objects under the circle? Is this a visual thing? If so consider using a block ( or donut for that matter ) with color 255,255,255 as a mask.

 

@ronjonp I understand  your tip, but in case I really need to break the lines. But the option of breaking the lines by the end points of the lines overlapping them serves my purposes. I even recognize that this alternative will be more advantageous.

[BIGAL]

Like ronjonp reminded me this was an answer for another post some years ago the advantage is that the length of the lines is to the centre of the circles and not the shortened length.

 

If all lines are meeting at end points can get every start end point in a list, sort and delete duplicates so only 1 circle is drawn.

 

circle - donut.lsp:(c-donut).lsp:; circle to donut by Homer simson who loves donuts 

Edited October 7, 2020 by BIGAL

[teknomatika]

@BIGAL You have a good memory. In fact, at the time, I sought help for this demand. In reality, I continue to look for an efficient routine that in all situations of overlapping lines they are broken at the end points.

The option to insert circles and trim could be one of them, but I admit it will be more efficient with the break use.

[Trudy]

Hello again teknomatika if you want can try this new version with break.

;Create from Georgi Georgiev - TRUDY
;Date 09.10.2020
(defun c:try1 ()
(vl-load-com)
(setvar "osmode" 0)

(setq listt nil)
(setq listt2 nil)
(setq list3 nil)
(setq list4 nil)

(Princ (strcat "\r Select lines "))
(setq sel1 (ssget '((0 . "line"))))
	(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
		(setq listt (cons (cdr (assoc 11 ent)) listt))
		(setq listt2 (cons (cdr (assoc 10 ent)) listt2))
			
	)
(setq list3 (append listt listt2))

	(while list3
		(setq list4 (cons (car list3) list4))
		(setq list3 (vl-remove (car list3) list3))
	)

(repeat (setq i (sslength sel1))
		(setq list5 list4)
		(setq nam (ssname sel1 (setq i (1- i))))
			(repeat (length list5)
				(setq pt_line (vlax-curve-getclosestpointto nam (car list5) t))
				(if (equal pt_line (car list5)) (command "BREAK" nam (car list5) "@") (princ))
				(setq list5 (cdr list5))
			)
)

(princ)

)

 

Edited October 9, 2020 by Trudy

[teknomatika]

@Trudy Thanks for the interest, help and effort.
I tested it and the principle I want is this.

However, I see that the break does not occur at all endpoints.
Attached file to better understand.

 

Edition: Already after the first test, I see that by repeating the procedure on the unbroken lines in the first phase, they are resolved.

 

cadtutor_09102020_test.dwg

Edited October 9, 2020 by teknomatika

[Trudy]

I see the problem teknomatika but in this moment dont know how change the code if someone elese can change i will be glad.

Solution for now to run the routine several times, because with one routine break the lines one time only.

 

How much overlap lines you expect.

I have one idea but tomorrow will try it.

 

Edited October 9, 2020 by Trudy

[teknomatika]

1 hour ago, Trudy said:

I see the problem teknomatika but in this moment dont know how change the code if someone elese can change i will be glad.

Solution for now to run the routine several times, because with one routine break the lines one time only.

 

How much overlap lines you expect.

I have one idea but tomorrow will try it.

 

Quote

 

@Trudy, 

Thank you very much. As it is, it is a precious help.

 

As for the number of overlapping lines, at least two. That is, as a rule I have a set of lines that should be overlapped on another set. Then enter the routine to detect those overlapping lines and make the break. Then, with another routine, the duplicated and overlapping lines are checked and the respective differentiation carried out using different colors and layers.

 

Update: In the meantime, in certain situations, I find that the routine does not act. What will be the problem? Apparently the lines in question have the same delta Y.
Attached file with the reported situation.

CADTUTOR_TEST_09102020_2.dwg

Edited October 9, 2020 by teknomatika
information update

[Trudy]

Hello, teknomatika i modifying the code with the last problem.

I want to know some more things, at the beginning whether all lines are in one layer or they are at different layers.

We will make it work

 

Replace line 33 with

                (if (equal pt_line (car list5) 0.0001) (command "BREAK" nam (car list5) "@") (princ))

Edited October 9, 2020 by Trudy

[Trudy]

Hello, teknomatika  i modify a lot the cod and think this may work

;Create from Georgi Georgiev - TRUDY
;Date 11.10.2020
(defun c:try1 ()
(vl-load-com)
(setvar "osmode" 0)

(setq listt nil) (setq listt2 nil) (setq list3 nil) (setq list4 nil) (setq lay nil) (setq lay2 nil) (setq br '()) (setq emplay nil)
(Princ (strcat "\r Select lines "))
;select lines,layers 
;move to new layer
(setq sel1 (ssget '((0 . "line"))))
	(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
		(setq listt (cons (cdr (assoc 11 ent)) listt))
		(setq listt2 (cons (cdr (assoc 10 ent)) listt2))
		;(setq lay (assoc 8 ent))
		(setq lay2 (subst (cons 8 (strcat "Trudy_" (cdr (assoc 8 ent)))) (assoc 8 ent) ent))
		(entmod lay2)
	)
(setq list3 (append listt listt2))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;remove duplicated points
	(while list3
		(setq list4 (cons (car list3) list4))
		(setq list3 (vl-remove (car list3) list3))
	)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;select all in new Trudy_ layer
;max needed repeat
(setq sel2 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>"))))

(repeat (setq i (sslength sel2))
		(setq list5 list4)
		(setq nam (ssname sel2 (setq i (1- i))))
			(setq n 0)
			(repeat (length list5)
				(setq pt_line (vlax-curve-getclosestpointto nam (car list5) t))

				(if (equal pt_line (car list5) 0.00001) 
						(progn
								(setq n (+ n 1))
								(setq br (cons n br))
						)
								(princ)
				)
				(setq list5 (cdr list5))
			)
)
(setq br (vl-sort br '>))
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;select all in new Trudy_ layer
;repeat times and break
(repeat (- (car br) 2)
	(setq sel3 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>"))))
	
		(repeat (setq i (sslength sel3))
				(setq list5 list4)
				(setq nam (ssname sel3 (setq i (1- i))))
					(repeat (length list5)
						(setq pt_line (vlax-curve-getclosestpointto nam (car list5) t))
						(if (equal pt_line (car list5) 0.0001) (command "BREAK" nam (car list5) "@") (princ))
						(setq list5 (cdr list5))
						(princ "\rBREAKING...         \r")
					)
		)
)
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;select all in new Trudy_ layer
;move all to old layer
(setq sel3 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>"))))
	(repeat (setq i (sslength sel3))
		(setq nam (ssname sel3 (setq i (1- i))))
		(setq ent (entget nam))
		(setq lay2 (subst (cons 8 (substr (cdr (assoc 8 ent)) 7)) (assoc 8 ent) ent))
		(entmod lay2)
	)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;delete all Trudy_ layers
(while (setq a (tblnext "LAYER" (null a)))
			(setq emplay (cons (cdr (assoc 2 a)) emplay))
)
;(princ emplay)
(foreach y emplay (if (wcmatch y "Trudy_*") (command "laydel" "N" y "" "Y")))

(princ (strcat "\n" "Select" " " (rtos (sslength sel1) 2 0) " " "lines"))
(princ (strcat "\n" "Found" " " (rtos (length list4) 2 0) " " "non duplicate points"))
(princ (strcat "\n" "Repeat" " " "breaking" " " (rtos (- (car br) 2) 2 0) " " "times"))
(princ (strcat "\n" "Result" " " "is" " " (rtos (sslength sel3) 2 0) " " "new lines"))

(princ)

)

The lisp is not very fast but that is for now  

[teknomatika]

@Trudy 

Once again I want to thank you for your help, interest and effort.
I tested the new version and for now it seems to work very well. Good job.

As for the previous question: Yes, the overlapping lines can be in different layers and in different colors and in different styles.

 

Not wanting to abuse your help, and being already a refinement, it would be interesting that the new lines created by the action of the routine, can be allocated in a specific layer, for example, identified as duplicate lines.

 

Thanks!

[Trudy]

Hello i glad to help you teknomatika

You can try and say if this is what you need from move duplicated point to new layer.

 

;Create from Georgi Georgiev - TRUDY
;Date 11.10.2020
(defun c:try1 ()
(vl-load-com)
(setvar "osmode" 0)

(setq listt nil) (setq listt2 nil) (setq list3 nil) (setq list4 nil) (setq lay nil) (setq lay2 nil) (setq br '()) (setq emplay nil) (setq dellst nil) (setq lil nil)
(Princ (strcat "\r Select lines "))
;select lines,layers 
;move to new layer
(setq sel1 (ssget '((0 . "line"))))
	(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
		(setq listt (cons (cdr (assoc 11 ent)) listt))
		(setq listt2 (cons (cdr (assoc 10 ent)) listt2))
		;(setq lay (assoc 8 ent))
		(setq lay2 (subst (cons 8 (strcat "Trudy_" (cdr (assoc 8 ent)))) (assoc 8 ent) ent))
		(entmod lay2)
	)
(setq list3 (append listt listt2))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;remove duplicated points
	(while list3
		(setq list4 (cons (car list3) list4))
		(setq list3 (vl-remove (car list3) list3))
	)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;select all in new Trudy_ layer
;max needed repeat
(setq sel2 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>"))))

(repeat (setq i (sslength sel2))
		(setq list5 list4)
		(setq nam (ssname sel2 (setq i (1- i))))
			(setq n 0)
			(repeat (length list5)
				(setq pt_line (vlax-curve-getclosestpointto nam (car list5) t))

				(if (equal pt_line (car list5) 0.00001) 
						(progn
								(setq n (+ n 1))
								(setq br (cons n br))
						)
								(princ)
				)
				(setq list5 (cdr list5))
			)
)
(setq br (vl-sort br '>))
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;select all in new Trudy_ layer
;repeat times and break
(repeat (- (car br) 2)
	(setq sel3 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>"))))
	
		(repeat (setq i (sslength sel3))
				(setq list5 list4)
				(setq nam (ssname sel3 (setq i (1- i))))
					(repeat (length list5)
						(setq pt_line (vlax-curve-getclosestpointto nam (car list5) t))
						(if (equal pt_line (car list5) 0.0001) (command "BREAK" nam (car list5) "@") (princ))
						(setq list5 (cdr list5))
						(princ "\rBREAKING...         \r")
					)
		)
)
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;select all in new Trudy_ layer
;move to duplicate layer
  (if (setq ss (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq li (ssname ss (setq i (1- i))))
        (setq lil (cons (list (cdr (assoc 10 (entget li))) (cdr (assoc 11 (entget li))) li) lil))
      )
      (foreach li lil
        (if (vl-some '(lambda ( x ) (or (and (equal (car li) (car x) 1e-6) (equal (cadr li) (cadr x) 1e-6)) (and (equal (car li) (cadr x) 1e-6) (equal (cadr li) (car x) 1e-6)))) (vl-remove li lil))
          (setq dellst (cons (caddr li) dellst))
        )
      )
    )
  ) 
  (setq brr (length dellst))
  (princ brr)
  	(repeat (length dellst)
		;(setq nam (ssname ss (setq i (1- i))))
		(setq ent (entget (car dellst)))
		;(princ ent)
		(setq lay2 (subst (cons 8 (strcat "duplicate_lines" )) (assoc 8 ent) ent))
		(entmod lay2)
		(setq dellst (cdr dellst))
	)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;select all in new Trudy_ layer
;move all to old layer
(setq sel3 (ssget "_X" '((-4 . "<or")(8 . "Trudy_*")(-4 . "or>"))))
	(repeat (setq i (sslength sel3))
		(setq nam (ssname sel3 (setq i (1- i))))
		(setq ent (entget nam))
		(setq lay2 (subst (cons 8 (substr (cdr (assoc 8 ent)) 7)) (assoc 8 ent) ent))
		(entmod lay2)
	)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;delete all Trudy_ layers
(while (setq a (tblnext "LAYER" (null a)))
			(setq emplay (cons (cdr (assoc 2 a)) emplay))
)
;(princ emplay)
(foreach y emplay (if (wcmatch y "Trudy_*") (command "laydel" "N" y "" "Y")))

(princ (strcat "\n" "Select" " " (rtos (sslength sel1) 2 0) " " "lines"))
(princ (strcat "\n" "Found" " " (rtos (length list4) 2 0) " " "non duplicate points"))
(princ (strcat "\n" "Repeat" " " "breaking" " " (rtos (- (car br) 2) 2 0) " " "times"))
(princ (strcat "\n" "Result" " " "is" " " (rtos (sslength sel3) 2 0) " " "new lines"))
(princ (strcat "\n" "Duplicate lines are" " " (rtos (/ brr 2) 2 0)))

(princ)

)

Duplicated part is from.

https://www.cadtutor.net/forum/topic/33136-help-select-duplicate-entities/page/4/#comments
marko_ribar

Edited October 12, 2020 by Trudy

[teknomatika]

@Trudy Good job. Much better.
It is a fact that with many entities it becomes a little slow, but it solves many of the situations that I face in my work.
For any improvement or change, I will ask again in the hope that you can help.