Lisp for Numbering overlapping lines.

[arpansark0544TCX]

I am working on electrical conducting.

I used a line to connect the circuits. As as a result there are multiple overlapping line. 

Is there a Lisp which could place a number near the overlapping line showing number of line operlapping.

Or a little advance if it can replace those lines with a numbered line type.

I am attaching a image for better understanding:

Option 1:

Advance option2:

[hak_vz]

@arpansark0544TCX  Attach sample drawing and in same drawing add numbered lines.  Always attach sample drawing with your requests.

[arpansark0544TCX]

Sir as requested by you I have attached the drawing file and my .lin file for numbered line type.

[hak_vz]

I'll work on it later today.

[arpansark0544TCX]

Thank you for your support.

Mean while i am working on it manually 😅.

too complex:

[hak_vz]

@arpansark0544TCX 

Here you have starting version that counts line overlaps and create text over overlapped lines. I will later today modify it to remove duplicates and replace line type of remaining line.

(defun c:pow_line_overlap ( / duplicates ss e ent i ptlist p)
	(defun duplicates ( lst )
		(if lst
			(if (member (car lst) (cdr lst))
				(cons (car lst) (duplicates (vl-remove (car lst) (cdr lst))))
				(duplicates (vl-remove (car lst) (cdr lst)))
			)
		)
	)
	(setq ss (ssget "X" '((0 . "LINE")(8 . "EE-R PHASE"))) i -1 ptlist nil)
	(while (< (setq i (1+ i)) (sslength ss))
		(setq 
			e (ssname ss i)
			ent (entget e)
			p (mapcar '* '(0.5 0.5)(mapcar '+ (cdr (assoc 10 ent))(cdr (assoc 11 ent))))
			ptlist (cons p ptlist)
		)
	)
	(setq dup (duplicates ptlist))
	(foreach pt dup
		(setq ss (ssget "_C" (mapcar '+ '(1 1) pt) (mapcar '+ '(-1 -1) pt) '((0 . "LINE"))))
			(entmake 
				(list
					(cons 0 "text")
					(cons 8 "EE-POWER CIRCUIT")
					(cons 10 pt)
					(cons 40 150)
					(cons 50 0)
					(cons 1 (itoa (sslength ss)))
				)
			)	
	)
	(princ "\nDone!")
	(princ)
)

[arpansark0544TCX]

It is working like a wonder.

Thank you.

Can't wait to see the advance option.

[hak_vz]

I will assume that linetypes are named "C1" "C2"......."C49"  according to your acad.lin.  To work correctly all power lines  must be placed in layer named "EE-R PHASE" . If this name changes depending on project, then I can change line selection so that you can pick a line on desired layer.

[arpansark0544TCX]

I have the following observation:

The code should be able to ask the user to select the bunch of lines to work on. So it can be user-friendly to other Cad users also.

This is what I think. However, I am still a beginner in Lisp coding .So don't know the practicality it is possible.

[hak_vz · Accepted solution]

Final edited version that will work in case of minor drafting errors as found in sample drawing

(defun c:pow_line_overlap ( / *error* duplicates ss e ent i ptlist p ovl old_expert dup)

;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-for-numbering-overlapping-lines/td-p/12478216
;author: hak-vz
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
; 05. january 2024. 
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(setvar 'cmdecho 1)
		(setvar 'expert old_expert)
		(vla-endundomark adoc)
		(princ)
	)
	(defun duplicates ( lst )
		(if lst
			(if (member (car lst) (cdr lst))
				(cons (car lst) (duplicates (vl-remove (car lst) (cdr lst))))
				(duplicates (vl-remove (car lst) (cdr lst)))
			)
		)
	)
	(setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
	(vla-endundomark adoc)
	(vla-startundomark adoc)	
	(setq old_expert (getvar 'expert))
	(setq ss (ssget "X" '((0 . "LINE")(8 . "EE-R PHASE"))) i -1)
	(setvar 'cmdecho 0)
	(while (< (setq i (1+ i)) (sslength ss))
		(setq 
			ent (entget (ssname ss i))
			a (cdr (assoc 10 ent))
			b (cdr (assoc 11 ent))
			ptlist (cons (mapcar 'fix (mapcar '* '(0.5 0.5)(mapcar '+ a b))) ptlist)
		)
	)
	(foreach pt (duplicates ptlist)
		(setq ss (ssget "_C" (mapcar '+ '(15 15) pt) (mapcar '+ '(-15 -15) pt) '((0 . "LINE"))))
		(setq i 0 ovl (sslength ss))
		(while (< (setq i (1+ i)) (sslength ss))
			(entdel (ssname ss i))
		)
		(setq e (ssname ss 0))
		(command "_.linetype" "load" (strcat "C" (itoa ovl)) "acad.lin" "")
		(command "_.chprop" e "" "LTYPE" (strcat "C" (itoa ovl)) "")
		(command "_.chprop" e "" "LTSCALE" 55 "")
		(setq ent (entget e))
		(setq ent (subst (cons 8 "EE-POWER CIRCUIT")(assoc 8 ent) ent))
		(setq ent (entmod ent))
	)
	
	(setvar 'expert old_expert)
	(setvar 'cmdecho 0)
	(vla-endundomark adoc)
	(princ "\nDone!")
	(princ)
)

[arpansark0544TCX]

I tested it out and it looks amazing.

Few observation :

Some lines are not changed which are overlapped as the code version 2.0  was not able to change them. 

But in Version 1.0 the code placed a number there.

[ВeekeeCZ]

(defun c:Multilining ( / :ltload s i d n m l a)
  
  (defun :ltload (lt)
    (if (or (tblsearch "ltype" lt)
	    (command "_.linetype" "_l" lt "acad" "")
	    (tblsearch "ltype" lt))
      lt
      "Continuous"))
  
  (if (setq s (ssget '((0 . "LINE"))))
    (repeat (setq i (sslength s))
      (setq d (entget (ssname s (setq i (1- i))))
	    n (list (cdr (assoc 10 d)) (cdr (assoc 11 d)))
	    m (mapcar '/ (apply 'mapcar (cons '+ n)) '(2 2))
	    a t
	    l (mapcar (function (lambda (x) (if (equal m (last x) 1e-2)
				     (progn
				       (setq a nil)
				       (cons (1+ (car x)) (cdr x)))
				     x)))
		      l)
	    l (if a (cons (list 1 n m) l) l))))
  
  (foreach e l (entmake (list '(0 . "LINE")
			      (cons 8 (getvar 'clayer))
			      (cons 6 (:ltload (strcat "C" (itoa (car e)))))
			      (cons 10 (caadr e)) (cons 11 (cadadr e)))))
  (command "_.erase" s "")
  (princ)
  )

[hak_vz]

@ВeekeeCZ  Great code as always. What it hast to be considered is that overlapping lines may also have different direction,  as in OP case. For this reason to simplify code I use line middle-point.

[hak_vz]

@arpansark0544TCX  Compare both versions of the code on some sample and test if they create equal result. I think that maybe I made a mistake with iterators in second version, since I didn't use your line types from "acad.lin"

[ВeekeeCZ]

---

@hak_vz wrote:

@ВeekeeCZ  Great code as always. What it hast to be considered is that overlapping lines may also have different direction,  as in OP case. For this reason to simplify code I use line middle-point.

---

Right, thanks. It seemed to me that it was all in the same direction. Well, it's mostly.

But the precision also isn't so perfect. Needed to lower the fuzz down to 1e-2

[hak_vz · Accepted solution]

@arpansark0544TCX  Code in post #10 is edited so it now works in case of minor drafting error as is shown in your post #11. If you make large zoom you can see that lines are drafted with error.

[arpansark0544TCX]

Thank you it worked charm this time.