Block replace and filling with existing texts

[l.slimV2U78]

Hello guys

long time lurker, first time poster.

as part of a bigger automation process, im trying to replace a sewer flow direction symbol with a dynamic version of the same, with attributes containing diameter information(DIA), and heights on both sides (BOBL and BOBR)

what i like to happen is the following

-replace old block (L_VHR) with dynamic block(SRI-STROOMRICHTING-SO) (same layer)

-if rotation of new block is between 90 and 270 degrees, rotate 180 degrees and flip (Flip state1)

-get a prompt to click on the texts to replace BOBL, DIA and BOBR (and remove the clicked text)

if possible also the following:

-click a line, set Distance1 and Distance2 to (1/2*length - 2,5)

so for a line of 50m length, Distance 1 and 2 would be 22,5m (1/2 * 50 -2,5)

-remove all (remaining) texts from the drawing

i managed the replacing of the blocks part, and also found text to attribute lisps. but i cant find a way to merge these, or have the attributes preset so you dont have to click so much, and also have no clue how to include the other parts.

i think(know) this all is just a bit above my level of understanding of autoLISP to figure out on my own, so could anyone help me with this?

what i have so far to replace the block is the following, derived from code of Kent1Cooper

(defun Vervangstroomrichting (/ ss n edata)
(command "-INSERT" "F:/LOCATION/SRI-STROOMRICHTING-SO.dwg") (command)
  (if (setq ss (ssget "_X" '((2 . "L_VHR"))))
    (repeat (setq n (sslength ss))
      (setq edata (entget (ssname ss (setq n (1- n)))))
      (entmod (subst '(2 . "SRI-STROOMRICHTING-SO") '(2 . "L_VHR") edata))
    ))
(command "_.attsync" "_name" "SRI-STROOMRICHTING-SO")
)

 base drawing looks like this

at the point of this lisp, i will have replaced the circle and square blocks with a dynamic one with an added attribute of the red text (already got this figured out)

thanks in advance

[ВeekeeCZ]

Post some sample dwg large enough to see patterns, both blocks... 

[l.slimV2U78]

Here is a small bit of the system, with a rectangle with the new dynamic block, and also a before and after of the whole process. 

the part that replaces the squares/triangles/circles i have already figured out.

[ВeekeeCZ · Accepted solution]

Layers sorting, objects removing, checking especially crowded spaces, all is up to you. Else, have fun in your spare time.

It takes some time, but the result seems quite persuasive.

(vl-load-com)

(defun c:PipeTrans ( / mdl lins blks lblr lbls e p f a d lin lbr lbd lba lbe new)
  
  (setq mdl (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  
  (if (and (setq lins (ssget "_X" '((0 . "LINE") (8 . "RIO_RWA,RIO_DWA"))))  	; layer
	   (setq lins (mapcar '(lambda (e) (cons e (mapcar '/ (mapcar '+ (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e)))) '(2 2))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex lins)))))
	   (setq blks (ssget "_X" '((0 . "INSERT") (2 . "L_VHR"))))		; block name
	   (setq blks (mapcar '(lambda (e) (cons e (cdr (assoc 10 (entget e)))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex blks)))))
	   (setq lblr (ssget "_X" '((0 . "TEXT") (8 . "RIO-AFM"))))		; layer
	   (setq lblr (mapcar '(lambda (e) (cons e (cdr (assoc 10 (entget e)))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex lblr)))))
	   (setq lbls (ssget "_X" '((0 . "TEXT") (8 . "RIO-BOK"))))		; layer
	   (setq lbls (mapcar '(lambda (e) (cons e (cdr (assoc 10 (entget e)))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex lbls)))))
	   )
    (foreach blk blks
      (setq p (cdr blk))
      (setq a (cdr (assoc 50 (entget (car blk)))))
      (if (setq f (and (> a (* pi 0.5)) (<= a (* pi 1.5))))
	(setq a (+ a pi)))
      (setq lin (car (vl-sort lins '(lambda (e1 e2) (< (distance p (cdr e1)) (distance p (cdr e2)))))
		     ))
      (setq d (max 1. (- (/ (getpropertyvalue (car lin) "Length") 2) 2.5 4.776)))
      (setq lbr (car (vl-sort lblr '(lambda (e1 e2) (< (abs (- 1.7 (distance p (cdr e1)))) (abs (- 1.7 (distance p (cdr e2)))))))))
      (setq lbd (vl-sort lbls '(lambda (e1 e2) (< (abs (- 2.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e1)) (cdr e1))))
						  (abs (- 2.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e2)) (cdr e2))))))))
      (if (< (cadar lbd) (cadadr lbd))
	(setq lba (car lbd)
	      lbb (cadr lbd))
	(setq lbb (car lbd)
	      lba (cadr lbd)))
      
      (setq new (vlax-vla-object->ename (vla-InsertBlock mdl (vlax-3d-point (cdr blk)) "SRI-STROOMRICHTING-SO" 1 1 1 a)))
      (setpropertyvalue new "AcDbDynBlockPropertyDistance1" d)
      (setpropertyvalue new "AcDbDynBlockPropertyDistance2" d)
      (if f (setpropertyvalue new "AcDbDynBlockPropertyFlip state1" 1))
      (setpropertyvalue new "DIA" (getpropertyvalue (car lbr) "TextString"))
      (setpropertyvalue new "BOBL" (getpropertyvalue (car lba) "TextString"))
      (setpropertyvalue new "BOBR" (getpropertyvalue (car lbb) "TextString"))
      ))
  (princ)
  )

[l.slimV2U78]

absolutely amazing! thank you!

you are right there's some small errors in the crowded spaces, but checking and changing those manually is fine. this will just cut down so much time/work on these drawings.

thanks again!

[l.slimV2U78]

I realized this doesnt work for the 'flat' sewer sections, because they do not have the arrow symbol. (theres one such section in the sample drawing at the bottom center)

i am trying to change it so it doesnt replace the triangle, but instead triggers on the 'RIO-AFM' text. i will solve the arrow direction issue differently. (block placement is fine, as i will just change the base point in the block editor to manually get it in the same location again)

i changed line 10 to the text, which works

	   (setq blks (ssget "_X" '((0 . "TEXT") (8 . "RIO-AFM"))))		; block name

problem is now the wrong values get copied into the block.

i tried editing the distance values in lines 27-30 but can't really figure out which values to change to what to get the right result.

@ВeekeeCZ 

could you tell me what values to get for this new situation, or explain what each of the values means so i can calculate the right ones to change myself.

or am i looking at the wrong place entirely to fix the issue?

the closest i got are these values, but they are just not quite there.

      (setq d (max 1. (- (/ (getpropertyvalue (car lin) "Length") 2) -3 6.1)))
      (setq lbr (car (vl-sort lblr '(lambda (e1 e2) (< (abs (- 1.7 (distance p (cdr e1)))) (abs (- 1.7 (distance p (cdr e2)))))))))
      (setq lbd (vl-sort lbls '(lambda (e1 e2) (< (abs (- 2.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e1)) (cdr e1))))
						  (abs (- 3.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e2)) (cdr e2))))))))
      (if (< (cadar lbd) (cadadr lbd))

[ВeekeeCZ]

Not sure where the flat area is. 

The entire routine is based on the L_VHR block existence. The insertion point as well as an angle (direction). If there is no L_VHR, no new block is inserted. 

These lines flip the angle. a is for angle in radians, f (T/nil) is for flipping the block then.

     (if (setq f (and (> a (* pi 0.5)) (<= a (* pi 1.5))))
	(setq a (+ a pi)))

[l.slimV2U78]

inside the blue circles is an example. over the whole network theres quite a few locations.

i will not touch the L_VHR before this, so there shouldnt be an issue with that i think.

when i run it with the values in my last post, this happens.

the bottom left one gives the wrong value.

if i run the original script this location gives the right values. so something with the distance values is wrong.

[ВeekeeCZ · Accepted solution]

Try this.

It additionally goes thru all lines and if there is no L_VHR within the distance of 0.5, then it inserts your block at the mid of the line.

(vl-load-com)

(defun c:PipeTrans ( / mdl lins blks lblr lbls e p f a d lin lbr lbd lba lbe new)
  
  (setq mdl (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  
  (if (and (setq lins (ssget "_X" '((0 . "LINE") (8 . "RIO_RWA,RIO_DWA"))))  	; layer
	   (setq lins (mapcar '(lambda (e) (cons e (mapcar '/ (mapcar '+ (cdr (assoc 10 (entget e))) (cdr (assoc 11 (entget e)))) '(2 2))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex lins)))))
	   (setq blks (ssget "_X" '((0 . "INSERT") (2 . "L_VHR"))))		; block name
	   (setq blks (mapcar '(lambda (e) (cons e (cdr (assoc 10 (entget e)))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex blks)))))
	   (setq lblr (ssget "_X" '((0 . "TEXT") (8 . "RIO-AFM"))))		; layer
	   (setq lblr (mapcar '(lambda (e) (cons e (cdr (assoc 10 (entget e)))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex lblr)))))
	   (setq lbls (ssget "_X" '((0 . "TEXT") (8 . "RIO-BOK"))))		; layer
	   (setq lbls (mapcar '(lambda (e) (cons e (cdr (assoc 10 (entget e)))))
			      (vl-remove-if 'listp (mapcar 'cadr (ssnamex lbls)))))
	   )
    (progn
      (foreach blk blks
	(setq p (cdr blk))
	(setq a (cdr (assoc 50 (entget (car blk)))))
	(if (setq f (and (> a (* pi 0.5)) (<= a (* pi 1.5))))
	  (setq a (+ a pi)))
	(setq lin (car (vl-sort lins '(lambda (e1 e2) (< (distance p (cdr e1)) (distance p (cdr e2)))))))
	(setq d (max 1. (- (/ (getpropertyvalue (car lin) "Length") 2) 2.5 4.776)))
	(setq lbr (car (vl-sort lblr '(lambda (e1 e2) (< (abs (- 1.7 (distance p (cdr e1)))) (abs (- 1.7 (distance p (cdr e2)))))))))
	(setq lbd (vl-sort lbls '(lambda (e1 e2) (< (abs (- 2.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e1)) (cdr e1))))
						    (abs (- 2.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e2)) (cdr e2))))))))
	(if (< (cadar lbd) (cadadr lbd))
	  (setq lba (car lbd)
		lbb (cadr lbd))
	  (setq lbb (car lbd)
		lba (cadr lbd)))
	
	(setq new (vlax-vla-object->ename (vla-InsertBlock mdl (vlax-3d-point (cdr blk)) "SRI-STROOMRICHTING-SO" 1 1 1 a)))
	(setpropertyvalue new "AcDbDynBlockPropertyDistance1" d)
	(setpropertyvalue new "AcDbDynBlockPropertyDistance2" d)
	(if f (setpropertyvalue new "AcDbDynBlockPropertyFlip state1" 1))
	(setpropertyvalue new "DIA" (getpropertyvalue (car lbr) "TextString"))
	(setpropertyvalue new "BOBL" (getpropertyvalue (car lba) "TextString"))
	(setpropertyvalue new "BOBR" (getpropertyvalue (car lbb) "TextString"))
	)
      (foreach lin lins
	(setq p (cdr lin))
	(if (not (vl-remove-if-not '(lambda (b) (< (distance p (cdr b)) 0.5)) blks))
	  (progn
	    (setq d (max 1. (- (/ (getpropertyvalue (car lin) "Length") 2) 2.5 4.776)))
	    (setq a (getpropertyvalue (car lin) "Angle"))
	    (if (> (getpropertyvalue (car lin) "StartPoint/X") (getpropertyvalue (car lin) "EndPoint/X"))
	      (setq a (+ a pi)))
	    (setq lbr (car (vl-sort lblr '(lambda (e1 e2) (< (abs (- 1.7 (distance p (cdr e1)))) (abs (- 1.7 (distance p (cdr e2)))))))))
	    (setq lbd (vl-sort lbls '(lambda (e1 e2) (< (abs (- 2.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e1)) (cdr e1))))
							(abs (- 2.5 (distance (vlax-curve-getclosestpointto (car lin) (cdr e2)) (cdr e2))))))))
	    (if (< (cadar lbd) (cadadr lbd))
	      (setq lba (car lbd)
		    lbb (cadr lbd))
	      (setq lbb (car lbd)
		    lba (cadr lbd)))
	    (setq new (vlax-vla-object->ename (vla-InsertBlock mdl (vlax-3d-point (cdr lin)) "SRI-STROOMRICHTING-SO" 1 1 1 a)))
	    (setpropertyvalue new "AcDbDynBlockPropertyDistance1" d)
	    (setpropertyvalue new "AcDbDynBlockPropertyDistance2" d)
	    (if f (setpropertyvalue new "AcDbDynBlockPropertyFlip state1" 1))
	    (setpropertyvalue new "DIA" (getpropertyvalue (car lbr) "TextString"))
	    (setpropertyvalue new "BOBL" (getpropertyvalue (car lba) "TextString"))
	    (setpropertyvalue new "BOBR" (getpropertyvalue (car lbb) "TextString")))))
      ))
      (princ)
      )

[l.slimV2U78]

amazing, thanks so much