Split Block Based on Polylines inside

Hi guys after nearly 1 month searching, reading and coding I kind of gave up, and just signed up for an account here seeking for some help, any advice would be much appreciated !!

What I've been trying to do is to split a block based on the small polyline rectangles inside, the closed polylines/rectangles are of same size. Any attributes tags contained within one rectangle should be created as one block at the same location. At the end, a numbers of smaller blocks will replace the old single block.

For example below I want to convert this single block (attached) to 6 individual blocks with attributes, tags updated for each:

Drawing1.dwg

Initially my idea was to separate them based on entities inside, I tried writing some lisp using nentsel, entnext, burst, insert, but didn't work well as I have thousands of blocks like this, sometimes 6 combined into one, sometimes 3 together, and entities were not always created from top to bottom in the data base. That's why I start to look into "polylines", but don't know how to make it work, as I am just a beginner in autolisp

Please help !

Using this

(setq obj (vlax-ename->vla-object (car (entsel))))
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
(setq minpt (vlax-safearray->list  minpoint))
(setq maxpt (vlax-safearray->list  maxpoint))

This finds the corners of the block. Then burst the block. Using the co-ords can make a selection set of the polylines, then find the text inside.

So now make a block of the pline with the text as attributes say tag1 tag2 etc and fill in the attribute values to the text value.

Phew !

Need lots of code in between.

A start.

(setq sspl (ssget "CP" (list minpt maxpt)))

; Text in polygons
; By Alan H may 2013
(vl-load-com)
(defun getcoords (ent)
 (vlax-safearray->list
   (vlax-variant-value
     (vlax-get-property
   (vlax-ename->vla-object ent)
   "Coordinates"
     )
   )
 )
)

(defun co-ords2xy ()
; convert now to a list of xy as co-ords are x y x y x y if 3d x y z x y z
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth I co-ords)(nth (+ I 1) co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
) ; end repeat
) ; end defun


; program starts here
; choose output file change acdatemp to what you want
(setq fname (strcat "c:/alan/" (getstring "\nEnter file name ")))
(setq fout (open fname "w"))
(setq plobjs (ssget (list (cons 0 "lwpolyline"))))
(setq numb1 (sslength plobjs))
(setq x numb1)
(repeat numb1
(setq obj (ssname plobjs (setq x (- x 1))))
(setq co-ords (getcoords obj))
(co-ords2xy)
; write pline co-ords here
(setq numb3 (length co-ords))
(setq z numb3)
(setq ansco-ords "")
(repeat numb3 
(setq ansco-ords (strcat ansco-ords (rtos (nth (setq z (- z 1)) co-ords) 2 3 ) " " ))
)
(setq ans (strcat "Pline " ansco-ords))
(write-line ans fout)
(setq ansco-ords "")
(setq ss (ssget "WP" coordsxy (list (cons 0 "Text,Mtext")))) ; selection set of text within polygon
(if (= ss nil) 
(princ "\nnothing inside")
(progn 
(setq coordsxy nil) ; reset for next time
(setq numb2 (sslength ss))
(setq y numb2)
(repeat numb2
(setq anstext (vlax-get-property (vlax-ename->vla-object (ssname ss (setq y (- y 1)))) "Textstring"))
(princ anstext) ; change to write text to file
(write-line (strcat "text " anstext) fout)
(princ "\n")
) ; end repeat2
(setq ss nil) ; reset for next poly
)
)
) ; end repeat1
(close fout)
(princ)

Hi BIGAL, thanks for the reply

But I tried vla-GetBoundingBox and returned "nil"

Any ideas ?

In the DWG attached, the small polyline rectangles were inside the block, which means normally we would have to open block editor to be able to select them, the difficulty for me is to obtain these rectangles, then select attributes bound by each rectangle and make a new block.

This finds the corners of the block

nosscc

Attach an example final result.

If the rectangles in the blocks are always the same, and the number of attributes per rectangle is fixed the algorithm could be much simpler.

Select all inserts based on a name and/or layer filter.

Iterate over the selection set.

For each existing insert:

• Collect the attribute values in a list.
  
• Based on that list insert one or more new standard blocks and fill out the attributes.
  
• Erase the original insert.
  

Hi Maratovich, attached here an example result

Example Result.dwg

Hi Roy

The problem is how we collect attributes bound by each rectangle within the block ?

See the example result here Example.dwg

I did this use some code manually, first I selected the big combined block, then I bursted it, then again I use codes below I manually window selected the first rectangle and attributes, to convert these text to attributes. Then again I select those attributes and type command "block" to make a new block. How do we automate this for 5000 combined blocks in a drawing ?

(defun c:txt2att ( / el i ss st bk ) (vl-load-com)

;(setq bk (ssget '((0 . "INSERT")) ))

;(c:BURST)

(if (setq ss (ssget "_:L" '((0 . "TEXT")))) ; "_:L" reject entities on locked layers

(repeat (setq i (sslength ss))

(setq el (entget (ssname ss (setq i (1- i))))

st (vl-string-translate " " "_" (cdr (assoc 1 el)))

) ;end of setq

(if (and (equal (strlen st) 11) (vl-string-search "-" st))

(setq st "SOR")

(setq st "QTY")

) ; end of if

(entmakex

(append '((0 . "ATTDEF"))

(vl-remove-if '(lambda ( pair ) (member (car pair) '(0 100 73))) el) ;end of vl-re

(list

(cons 70 0)

(cons 74 (cdr (assoc 73 el)))

(cons 2 st)

(cons 3 st)

)

)

) ; end of entmakex

(entdel (cdr (assoc -1 el))) ;end of this line

) ; end of repeat

) ;end of if

(princ)

)

Maratovich look at 1st post dwg and final.

Nosscc have a look at this image I am trying to explain the sequence.

Thank you Bigal ! I think I understand your codes now

That was such a brilliant idea, I will spend time working on it

Hi BIGAL,

I can just use your (vla-GetBoundingBox obj 'minpoint 'maxpoint) method again to select texts within polyline, no need to use Alan H's code

Then I used txt2att lisp (pasted above) to convert them to block attributes. This was successful and they remain in the same position

Now my question is, how can we turn these attributes into a block ?

If I do it manually I select attributes and use command "block" then enter a block name, click ok, ok.

With lisp I read some threads use "insert", but its input are text values, I don't know what will happen to its tags

Some other thread suggests to use "entmake" and define block insertion point, define attributes with attribute insertion points..which sounds a lot of work

Do we have an easier way?

If I look at the Example.dwg I am surprised by the desired result. Why create 6 block definitions that are identical? Why multiple attribute tags with the same name (this is very bad)? And why the random insertion points?

Sorting the attributes belonging to the existing block is possible. See the code below. So my previous suggestion would seem feasible.

Pity the existing block also has a random insertion point. But establishing the bottom left corner (after deleting the existing attributes) is possible. And that point can be used to calculate the insertion points for the new blocks.

(defun KGA_List_Divide_3 (lst / ret)
 (repeat (/ (length lst) 3)
   (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
   (setq lst (cdddr lst))
 )
 (reverse ret)
)

; (SortedAttValueList (car (entsel))) =>
; (
;   (("DESC1" "AA") ("TETHERSOR" "10-10-00-00") ("TETHERQTY" "15"))
;   (("DESC2" "BA") ("DFNENCLSOR" "07-07-01-09") ("DFNENCLNO" "1")) 
;   (("DESC3" "CA") ("SPLICESOR" "02-02-04-06") ("NOOFSPLICE" "10")) 
;   (("DESC4" "AB") ("SPLITSOR" "07-02-05-04") ("SPLITRQTY" "1")) 
;   (("DESC5" "AC") ("LFNOTDRSOR" "55-06-06-06") ("LFNQTY" "1")) 
;   (("DESC6" "DB") ("FIBERSOR" "22-04-03-05") ("FIBERQTY" "2"))
; )
(defun SortedAttValueList (enm / obj)
 (setq obj (vlax-ename->vla-object enm))
 (vl-sort
   (mapcar
     '(lambda (sub)
       (mapcar 'cdr (vl-sort sub '(lambda (a b) (< (car a) (car b)))))
     )
     (KGA_List_Divide_3
       (mapcar
         '(lambda (att / tag)
           (setq tag (strcase (vla-get-tagstring att)))
           (list
             (cond
               ((wcmatch tag "DESC*") 0)
               ((wcmatch tag "*SOR")  1)
               (T                     2)
             )
             tag
             (vla-get-textstring att)
           )
         )
         (vlax-invoke obj 'getattributes)
       )
     )
   )
   '(lambda (a b) (< (caar a) (caar b)))
 )
)

BIGAL was based on the notorious Al Capone gangster.

Al is short for Alan

I wonder who that Alan H guy is?

Here is another variant

This is not a lisp is a program

SplitBlock.zip

Nice code Roy! I like the sorting by wcmatch part, where you used cond.

@Grrr: Thanks. My first idea was to use wcmatch inside the vl-sort condition. But that proved to be rather difficult.

@Grrr: Thanks. My first idea was to use wcmatch inside the vl-sort condition. But that proved to be rather difficult.

I think the way you wrote it should perform alot faster, since vl-sort woud try to compare every pair of items, hence n-times more evaluating.

So overall, for the vl-sort I think that comparing the nths of a and b is enough for most of the cases (if not all) - just like you did.

Roy_043 , Grrr

And what will you do if there are other attributes in the blocks?

therefore done # 16