Circles at the end of lines and trim around

[Trudy]

@teknomatika I glad to help you if someone else solve the break without using "command"  i think will be much faster.

But yea with many entities is very slow.

[ronjonp]

@Trudy

FWIW .. you should learn to localize your variables like so then you don't need to worry about setting all those lists to nil

(defun c:try1 (/ A BR BRR DELLST EMPLAY ENT I LAY LAY2 LI LIL LIST3 LIST4 LIST5 LISTT LISTT2 N NAM PT_LINE SEL1 SEL2 SEL3 SS)
...

 

Edited October 12, 2020 by ronjonp

[Trudy]

Hello, @ronjonp thank you i didnt know this.

Thank you.

[ronjonp]

2 hours ago, Trudy said:

Hello, @ronjonp thank you i didnt know this.

Thank you.

Cheers 

[BIGAL]

Using vlide, tools, check  text in editor, you will see in the <Build output window> the global variables you can copy this to your code. Thanks to lee-mac for that tip.

[teknomatika]

@Trudy and others

 

I return to the subject. Occasionally the routine fails to break. It is strange because everything indicates that the overlap of the lines is strict, with the same delta y.
I attach the file with the situation so I ask for help again.

What will be competing for this to happen? How to get around the situation?

 

Thanks!

 

 

test_02112020.dwg

[Trudy]

Hello, teknomatika

Work fine for me with this test file. Can you attach something other for testing.

 

 

[teknomatika]

14 hours ago, Trudy said:

Hello, teknomatika

Work fine for me with this test file. Can you attach something other for testing.

 

 

@Trudy

Thank you for your attention and response.
This situation occurs occasionally and what intrigues me is this inconsistency for no apparent reason.
What can contribute to this?

[teknomatika]

Even in the example test, I copied the same entities from another session and pasted it into the example session and in those pasted entities it works and the previous one does not, being the same. Intriguing.

[ketxu]

Oh, why not just make a wipeout "circle" or block with wipeout, then insert at the end of lines ?

[Trudy]

I modify a little, because i find a problem when all lines ar duplicated.

This is the new.

;Create from Georgi Georgiev - TRUDY
;Date 11.10.2020
(defun c:try1 ( / A BR BRR DELLST EMPLAY ENT I LAY LAY2 LI LIL LIST3 LIST4 LIST5 LISTT LISTT2 N NAM PT_LINE SEL1 SEL2 SEL3 SS)
(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>"))))
(if sel3
	(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"))
(if sel3 (princ (strcat "\n" "Result" " " "is" " " (rtos (sslength sel3) 2 0) " " "new lines")) (princ "\nall lines are duplicate"))
(princ (strcat "\n" "Duplicate lines are" " " (rtos (/ brr 2) 2 0)))

(princ)

)