Merging 2 instances of the same block into one and combining their attributes.

[wee]

I need to be able to combine 2 block into 1 based on their insertion points, they are very close but not exact. I need to combine the attributes into one and then delete to other. I have attached a simple drawing with around 10 examples with a better explanation. I will have drawings that have 100's of these I need to do automatically.

Brian

combine-piece-numbers-hsrb-ii.dwg

[BIGAL]

Simplest way is block 3 and if you want erase block1 and 2.

 

Have  a look at this uses same block can add erase etc, note I used bedit and moved the attribute to left text alignment left also. Do before running.

 

I pick the two blocks just in case layers are different, you do need to pick the ssget twice will fix say ver 2 this is just a yes it works test.

 

; convert two blocks to one
; by alanh Nov 2019 

(defun c:test ( / obj ss ss2 t1 t2 b1 b2 lay  ins att )
(setvar 'cmdecho 0)
(setq obj (vlax-ename->vla-object (car (entsel "pick block 1"))))
(setq obj2 (vlax-ename->vla-object (car (entsel "pick block 2"))))

(setq name (vla-get-effectivename obj))
(setq scalex  (abs (vla-get-xscalefactor obj)))
(setq scaley  (abs (vla-get-yscalefactor obj)))
(setq scalef  (* scalex 9.5) )
(prompt "\nselect all blocks")
(setq ss (ssget  (list (cons 0 "insert")(cons 8 (vla-get-layer obj)))))

(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq ins (vlax-get Obj 'insertionPoint))
(setq att (vla-get-textstring (nth 0 (vlax-invoke Obj 'getattributes))))
(setq lst (cons (list (car ins)(cadr ins) att) lst))
)


(setq lay (vla-get-layer obj2))
(repeat (setq x (length lst))
(setq plst (nth (setq x (- x 1)) lst))
(princ x)
(setq p1 (list (nth 0 plst)(nth 1 plst)))
(setq p2 (polar p1 (* pi 0.25) scalef))
(setq p3  (polar p1 (* pi 1.25) scalef))
(setq ss2 (ssget "f" (list p2 p3)(list (cons 0 "insert")(cons 8 lay)) ))
(if (= ss2 nil)
(princ "\nMiss\n")
(progn
(setq t1 (nth 2 plst))
(setq obj (vlax-ename->vla-object (ssname ss2 0 )))
(setq t2 (vla-get-textstring (nth 0 (vlax-invoke Obj 'getattributes))))
(command "-insert" name p1 scalex scaley 0 (strcat t1 " " t2))
)
)
)

;(command "erase" ss ss2 "")

)
(c:test)

 

 

Edited November 3, 2019 by BIGAL

[wee]

Thank You...I will give it a try this morning.

 

Brian

[wee]

I get a  "Command: ; error: malformed list on input"  error when I load the the routine and it will not run.

 

Brian

[wee]

I got the malformed error fixed and I'm working thru the routine now.

 

Brian

[wee]

How does this routine match up the different blocks....?  When I run it on a group it will miss-match some of the blocks. Ideally it would match them up based off insertion points...say with in a 3" radius.

 

Brian

[wee]

Here is the corrected code or at least what I had to do to get it to run, (I could have broken the part of the code that matches the blocks up correctly) it was just a couple missing parenthesis and I took out the space between the combined attribute.  I still can't get it to match them all up correctly.

 

; convert two blocks to one
; by alanh Nov 2019 

(defun c:CCC (/ obj ss ss2 t1 t2 b1 b2 lay lst lst2 ins att) 
(setq obj (vlax-ename->vla-object (car (entsel "pick block 1"))))
(setq lay (vla-get-layer obj))
(setq name (vla-get-effectivename obj)) 
(prompt "\nselect all blocks")
(setq ss (ssget (list (cons 0 "insert")(cons 8 lay))))
(setq obj (vlax-ename->vla-object (car (entsel "pick block 2"))))
(setq lay (vla-get-layer obj))
(prompt "\nselect all blocks")
(setq ss2 (ssget (list (cons 0 "insert")(cons 8 lay))))
(setq lst '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq ins (vlax-get Obj 'insertionPoint))
(setq att (vla-get-textstring (nth 0 (vlax-invoke Obj 'getattributes))))
(setq lst (cons (list (car ins)(cadr ins) att) lst))
)
(setq lst (vl-sort lst '(lambda (x y)
(cond
((= (cadr x)(cadr y))
(< (car x)(car y)))
((< (cadr x)(cadr y)))
))))
(setq lst2 '())
(repeat (setq x (sslength ss2))
(setq obj (vlax-ename->vla-object (ssname ss2 (setq x (- x 1)))))
(setq ins (vlax-get Obj 'insertionPoint))
(setq att (vla-get-textstring (nth 0 (vlax-invoke Obj 'getattributes))))
(setq lst2 (cons (list (car ins) (cadr ins) att) lst2))
)
(setq lst2 (vl-sort lst2 '(lambda (x y)
(cond
((= (cadr x)(cadr y))
(< (car x)(car y)))
((< (cadr x)(cadr y)))
))))

(if (= (length lst)(length lst2))
(princ "ok")
(exit) ;hard crash out
)
(setvar 'clayer "0")
(repeat (setq x (length lst))
(setq b1 (nth (setq x (- x 1)) lst))
(setq b2 (nth  x  lst2))
(setq ins (list (car b2)(cadr b2)))
(setq t1 (caddr b1))
(setq t2 (caddr b2))
(command "-insert" name ins 0.65 0.65 0 (strcat t1 "" t2))
(command "erase" ss ss2 "")
))

Brian

[wee]

I just realized it works fine on the example drawing I posted above but doesn't work for a drawing with additional stonemark blocks.  Not sure what the difference is....?  See additional dwg below. When ran on just the block surrounded by the yellow rectangle in the upper LH corner it flips the 1438 and the 1309 3rd row down on the left. I can't figure it out.

 

Brian

combine-piece-numbers-hsrb-ii----orginal------.dwg

[BIGAL]

I knew it would only work if a perfect dwg of matched pairs and that they were close. I need to look at checking the distance between lst and lst2 items. It will mean a bit of a rewrite.

[wee]

The ones that get swapped are with 1/2” of each other for the example in the yellow rectangle.... But if you run it on the whole file some are swapped that aren’t even close to each other. I worked on it off and on all day but never could figure out how fix this issue.... That said I know almost nothing about coding.  I will not be back in the office till Tuesday to continue working on this.

 

Thank You very much.....

Brian

[BIGAL]

Yeah its doing all sort of screwy stuff just 1 block will be wrong will have to revert back to a different way all together looking at what is next to a block. Not a big problem just a rewrite.

 

The blocks are not random enough when comparing the X & Y.

[BIGAL]

I have rewritten the search part the code is updated in my 1st code post uses a different method looks for the second block, it uses the block scale to work out a search distance. I have noticed the two blocks are not the same pattern throughout the dwg  just displaced a little bit in any direction. If to far will miss.

 

Took about 1 second 350 duplicates.

 

As far as I can tell correct now need to be checked 

[wee]

Just got back in the office today after an enjoyable trout fishing trip with my dad and Son.  I'll run this through its paces this morning.

 

Thank You

Brian

[wee]

Great work....I checked each and every block and it didn't miss a one. The only issue I had was after I un-commented the line to have it delete the 2 original block it only deletes the first one. That isn't a big deal to me because I keep them all on different layers so it's easy to just isolate and delete them that way.

 

Thank you again....

Brian  

[wee]

I was going to send you a PM and ask what I owe you but apparently my post count isn't high enough to be allowed to do that.....So I'll ask here.

 

Also do you do more intensive programing for pay.....?  

 

Brian 

[BIGAL]

I know why second did not erase I only look for the block now will add second block to a ssadd as I find them then they will erase.

 

I have added a choice yes or no for erase, need to make sure its working ok before erase.

 

Send me a private mail and we can discuss doing programming.

Edited November 6, 2019 by BIGAL

[BIGAL]

Did it write all the dwg's ok for each lot, I have been testing with Autocad CIV3d, the wblock asks for wether you want MAP to be included. Can you just type this on command line

 

(vlax-product-key) mine returns "Software\\Autodesk\\AutoCAD\\R23.1\\ACAD-3000:409" what does yours show.

[wee]

I’ll check when I get to the office in the morning....

 

Brian

[wee]

"Software\\Autodesk\\AutoCAD\\R22.0\\ACAD-1001:409"

 

That is what I get....

 

Brian