Get block sides from polyline path

[kajanthangavel]

Hi dear, I have thousands of manhole drawings and thousands of routing drawings. I need to identify which cable is going out from which side. I can't do it one by one, so I need a LISP for this. Could you please create a LISP?

Result like this

[hak_vz]

@kajanthangavel 

Here is my work in progress, just to show you that I started to work on it. Hope to finish it tomorrow.

You have very complex combination with blocks and mleaders.  Why not block attributes?

[kajanthangavel]

@hak_vz 

Thank you for your reply, I appreciate you.😀

This drawing is from a client, and I take it for construction. However, I can make all blocks into attribute blocks. can you create Lisp for this drawing? I have posted a sample drawing with attribute blocks.🤔

[hak_vz]

@kajanthangavel I'll use this dwg as a base for new lisp. This is better option then using mleaders. Even better would be to have in and out attribute inside block but that is not the case. I'm currently at work so I'll try to finish the code later today. Attach some more cases in dwg for better testing. 

[hak_vz · Accepted solution]

@kajanthangavel  Here is your code. It should work OK according to my tests, but you newer know.Since you know some tricks with autolisp you should add to my code writing out to output file however you like it.

Also, rename your blocks so there is no empty space in block name i.e. replace " " with "_" or "-", and don't change MH-ID.

Code uses vector algebra, if you need some explanation just ask. At the moment I'm not having time to do so.

(defun c:mhout 
	( / take take2 pointlist2d create_value_vector unit_vect vect_dot mod_vect m*v
		rot_vect acos asin angle_strike getattributevalue cable cable_points ss i eo
		vec_list ip mh_name cnt cnt_prev cnt_next vec_in vec_out in out	
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	(defun take2 (lst)(take 2 lst))
	(defun pointlist2d (lst / ret) (while lst (setq	ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
	(defun create_value_vector (n val / r ) (repeat n (setq r (cons val r))) r)
	(defun unit_vect (v)(mapcar '* v (create_value_vector (length v) (/ 1 (mod_vect v)))))
	(defun vect_dot (v1 v2)(apply '+ (mapcar '* v1 v2)))
    (defun mod_vect (v)(sqrt(vect_dot v v)))
	(defun m*v (mat vect / r i )
		(if 
		   (and (eq (length(car mat)) (length vect)))
			(progn
				(setq i 0)
				(repeat (length mat)
					(setq r (append r (list(list (apply '+ (mapcar '* vect (nth i mat)))))) i (+ i 1))
				)
			r
			)        
		)
	)
	(defun rot_vect (vect ang / mat)
		(setq mat 
		(list
			(list (cos ang) (* -1.0 (sin ang)))
			(list (sin ang) (cos ang)))
		)
		(apply 'append (m*v mat vect))
	)
	(defun acos (x)
	  (cond 
		((and(>= x -1.0)(<= x 1.0)) (-(* pi 0.5) (asin x)))
	  )
	)
	(defun asin (x)
	  (cond 
		((and(> x -1.0)(< x 1.0)) (atan (/ x (sqrt (- 1.0 (* x x))))))
		((= x -1.0) (* -1.0 (/ pi 2)))
		((= x  1) (/ pi 2))
	  )
	)
	(defun angle_strike (un_vect_dir  un_vec_pt / ang)
		(acos (/ (vect_dot un_vect_dir un_vec_pt) (* (mod_vect un_vect_dir)(mod_vect un_vec_pt))))
	)
	(defun getattributevalue ( blk tag )
		(setq tag (strcase tag))
		(vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
	)
	(cond 
		((setq cable (car(entsel "\nSelect optic cable >")))
			(setq cable_points (pointlist2d (vlax-get (vlax-ename->vla-object cable) 'coordinates)))
			(setq ss (ssget "_F" cable_points '((0 . "INSERT")(2 . "Manhole*")))) 
			(setq i -1)
			(while (< (setq i (1+ i))(sslength ss))
				(setq eo (vlax-ename->vla-object (ssname ss i)))
				(setq vec_list 
					(list 
						(rot_vect '(0 1) (vlax-get eo 'rotation))
						(rot_vect '(1 0) (vlax-get eo 'rotation))
						(rot_vect '(0 -1) (vlax-get eo 'rotation))
						(rot_vect '(-1 0) (vlax-get eo 'rotation))
					)
				)
				(setq mh_name (getAttributeValue  eo "MH-ID"))
				(setq ip (take2(vlax-get eo 'insertionPoint)))
				(setq ip (car (vl-sort cable_points '(lambda (x y)(< (distance ip x)(distance ip y))))))
				(setq cnt (vl-position ip cable_points))
				(setq cnt_prev (1- cnt) cnt_next (1+ cnt))
				(setq vec_in (unit_vect(mapcar '- (nth cnt_prev cable_points)(nth cnt cable_points))))
				(setq vec_out (unit_vect(mapcar '- (nth cnt_next cable_points)(nth cnt cable_points))))
				(setq in (car(vl-sort-i vec_list '(lambda (x y) (< (angle_strike vec_in x)(angle_strike  vec_in y))))))
				(setq in (nth in '("A" "B" "C" "D")))
				(setq out (car(vl-sort-i vec_list '(lambda (x y) (< (angle_strike vec_out x)(angle_strike  vec_out y))))))
				(setq out (nth out '("A" "B" "C" "D")))
		
				;add code for autput to file as you like
				(princ (strcat "\n" mh_name " " in " "out))
			)
		)
	)
	(princ "\nDone!")
	(princ)
)

[Sea-Haven]

I was just wondering about the labelling should it be like

BUILDING-2 C B MHA-124
MMH-124 B D MMH-102
 MMH-102 B D MHA-136

MHA-136 A BUILDING-1

[kajanthangavel]

Excellent work, 😃 it saves me a lot of time. I appreciate it, thank you. 😊

[kajanthangavel]

@Sea-Haven

That is enough for me, because I need the number of duct holes on each side.

Example for manhole duct holes,

After that result, I will decide if the number of duct holes is enough or not.

Thank you for support 😀

[komondormrex · Accepted solution]

hi there,

yet another one

;****************************************************************************************************************

(defun angle_sum (add_1 add_2)
	(if (>= (+ add_1 add_2) (* 2 pi)) (- (+ add_1 add_2) (* 2 pi)) (+ add_1 add_2))
)

;****************************************************************************************************************

(defun vectors_angle (vector_1 vector_2 / x1 y1 z1 x2 y2 z2 ccw cos_a sin_a alpha)
  	(mapcar 'set '(x1 y1 z1) (mapcar '- (cadr vector_1) (car vector_1)))
  	(mapcar 'set '(x2 y2 z2) (mapcar '- (cadr vector_2) (car vector_2)))
	(setq cos_a (/ (+ (* x1 x2) (* y1 y2) (* z1 z2))
				   (* (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x1 y1 z1))))
					  (sqrt (apply '+ (mapcar '(lambda (number) (expt number 2)) (list x2 y2 z2))))
				   )
				)
		  sin_a (sqrt (- 1 (expt cos_a 2)))
	)
	(cond
		((zerop cos_a) (* 0.5 pi))
		((zerop (setq alpha (atan (/ sin_a cos_a)))) pi)
		((minusp alpha) (+ pi alpha))
		(t alpha)
	)
)

;****************************************************************************************************************

(defun round (in_number precision / out_number)
	(if (zerop precision)
		(setq out_number (atoi (rtos in_number 2 precision)))
		(setq out_number (atof (rtos in_number 2 precision)))
	)
	out_number
)

;****************************************************************************************************************

(defun c:cable_manholes (/ cable cable_vertices insert_list east cardinal_directions_list reference_vertex reference_param
						 in_reference_vertex out_reference_vertex in_designator out_designator manhole_designator
					  )
	(setq cable (car (entsel "\Pick a cable:"))
		  cable_vertices_list (mapcar 'cdr (vl-remove-if-not '(lambda (group) (= 10 (car group))) (entget cable)))
		  insert_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_f" cable_vertices_list '((0 . "insert") (2 . "manhole*"))))))
	)
	(foreach insert insert_list
		(setq east (cdr (assoc 50 (entget insert)))
			  cardinal_directions_list (mapcar '(lambda (direction designator) (cons direction designator))
												(mapcar 'angle_sum (list east east east east) (list 0 (* 0.5 pi) pi (* 1.5 pi)))
											   '(b a d c)
									   )
			  reference_vertex (vlax-curve-getclosestpointto cable (cdr (assoc 10 (entget insert))))
			  reference_param (round (vlax-curve-getparamatpoint cable reference_vertex) 0)
			  in_reference_vertex (vlax-curve-getpointatparam cable (1- reference_param))
			  out_reference_vertex (vlax-curve-getpointatparam cable (1+ reference_param))
			  in_designator (if (vl-some '(lambda (cardinal) (< (vectors_angle (list reference_vertex in_reference_vertex)
			  																   (list reference_vertex (polar reference_vertex (car (setq designator_found cardinal)) 1))
																)
																(* 0.25 pi)
															 )
										  )
			  							  cardinal_directions_list
								)
								(cdr designator_found)
							)
			  out_designator (if (vl-some '(lambda (cardinal) (< (vectors_angle (list reference_vertex out_reference_vertex)
			  																	(list reference_vertex (polar reference_vertex (car (setq designator_found cardinal)) 1))
																 )
																 (* 0.25 pi)
															  )
										   )
			  							   cardinal_directions_list
								 )
								 (cdr designator_found)
							 )
			 manhole_designator (getpropertyvalue insert "mh-id")
		)
		(princ "\n") (princ manhole_designator) (princ ";") (princ in_designator) (princ ";") (princ out_designator)
	)
	(princ)
)

;****************************************************************************************************************

[kajanthangavel]

working, I appreciate it, thank you. 🙂