Topic: Help to code this lisp

[HasanCAD]

I want to code this lisp. So can some help me just the steps and commands i'll do the rest

The problem which I face is, In some drawings which come from the client, there are a lot of blocks.
I want to detect the blocks which has no sub-entities (but attribute) and add a rectangle inside this block, If it is an attribute add a line from 0,0, to insertpoint of attribute.

Thanks

[kojacek]

Try it:
Function jk:BLK_GetInsertAtts gets a list of attributes in block reference, and
function cd:BLK_GetEntity gets objects in block definition.
The command for test named TEST-INS gets list of two lists: attribs enames, and list of other objects into block definition (but not ATTDEFs), for your selected block.
Sorry for my English

Code - Auto/Visual Lisp: [Select]

1. ; =========================================================================================== ;
2. ; Lista obiektow w definicji bloku / List of objects in block definition                      ;
3. ;  Name   [STR] - nazwa bloku / block name                                                    ;
4. ;  Entity [STR] - nazwa entycji / entity name                                                 ;
5. ; ------------------------------------------------------------------------------------------- ;
6. ; (cd:BLK_GetEntity "*Model_space" nil), (cd:BLK_GetEntity "NAZWA" "*LINE")                   ;
7. ; =========================================================================================== ;
8. (defun cd:BLK_GetEntity (Name Entity / en dt res)
9.   (setq en (tblobjname "BLOCK" Name))
10.   (while
11.     (and
12.       en
13.       (setq en (entnext en))
14.       (setq dt (entget en))
15.       (/= "ENDBLK" (cdr (assoc 0 dt)))
16.     )
17.     (if
18.       (if Entity
19.         (wcmatch (cdr (assoc 0 dt))(strcase Entity))
20.         (cdr (assoc 0 dt))
21.       )
22.       (setq res
23.         (cons
24.           (cdr (assoc -1 dt))
25.           res
26.         )
27.       )
28.     )
29.   )
30.   (reverse res)
31. )
32. ; =========================================================================================== ;
33. ; List of <ename> attribs in block reference
34. ; =========================================================================================== ;
35. (defun jk:BLK_GetInsertAtts (Ename / d a n o res)
36.   (if
37.     (and
38.       (setq a (cdr (assoc 66 (setq d (entget Ename)))))
39.       (not (zerop a))
40.     )
41.     (progn
42.       (setq n T)
43.       (while n
44.         (setq Ename (entnext Ename)
45.               d (entget Ename)
46.               n (/= "SEQEND" (setq o (cdr (assoc 0 d))))
47.         )
48.         (if
49.           (= o "ATTRIB")
50.           (setq res (cons (cdr (assoc -1 d)) res))
51.         )
52.       )
53.     )
54.   )
55.   (reverse res)
56. )
57. ; =========================================================================================== ;
58. (defun C:TEST-INS (/ s d)
59.   (if
60.     (and
61.       (setq s (entsel "\nSelect block: "))
62.       (= "INSERT" (cdr (assoc 0 (setq d (entget (car s))))))
63.     )
64.     (list
65.       (jk:BLK_GetInsertAtts (car s))
66.       (vl-remove-if
67.         '(lambda (%)
68.           (= "ATTDEF" (cdr (assoc 0 (entget %))))
69.         )
70.         (cd:BLK_GetEntity (cdr (assoc 2 d)) nil)
71.       )
72.     )
73.   )
74. )

[HasanCAD]

Thanks kojacek for your quick reply
 
PLease find attached a file has sa sample of 2 blocks
one has no objects this blocks i want to draw a rectangle inside - (lets say 1000x1000)
another one has attribute only
 
If no objects draw a rectangle inside the block
if att only draw a line from 0,0 of the block to inspoint of any att inside the block too
 
Regards

[kojacek]

Thanks kojacek for your quick reply
 
PLease find attached a file has sa sample of 2 blocks
one has no objects this blocks i want to draw a rectangle inside - (lets say 1000x1000)
another one has attribute only
 
If no objects draw a rectangle inside the block
if att only draw a line from 0,0 of the block to inspoint of any att inside the block too
 
Regards

For make rectangle in "empty" block:
Load this code:

Code - Auto/Visual Lisp: [Select]

1. ; =========================================================================================== ;
2. (setq *cd-Blocks* (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
3. ; =========================================================================================== ;
4. ; Tworzy obiekt typu LWPOLYLINE / Creates a LWPOLYLINE object                                 ;
5. ;  Space  [VLA-Object] - kolekcja / collection | Model/Paper + Block Object                   ;
6. ;  Pts    [LIST]  - lista wierzcholkow polilinii / list of polyline vertex                    ;
7. ;  Closed [T/nil] - nil = otwarta / open                                                      ;
8. ;                   T   = zamknieta / closed                                                  ;
9. ; ------------------------------------------------------------------------------------------- ;
10. ; (cd:ACX_AddLWPolyline (cd:ACX_ASpace) (list '(5 5) '(15 5) '(15 10) '(10 10)) nil)          ;
11. ; =========================================================================================== ;
12. (defun cd:ACX_AddLWPolyline (Space Pts Closed / obj)
13.   (setq Pts
14.     (apply
15.       (quote append)
16.       (mapcar
17.         (function
18.           (lambda (%)
19.             (list (car %) (cadr %))
20.           )
21.         )
22.         (mapcar
23.           (function
24.             (lambda (%)
25.               (trans % 1 (trans '(0 0 1) 1 0 T))
26.             )
27.           )
28.           Pts
29.         )
30.       )
31.     )
32.   )
33.   (setq obj
34.     (vla-AddLightweightPolyline Space
35.       (vlax-make-variant
36.         (vlax-safearray-fill
37.           (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length Pts))))
38.           Pts
39.         )
40.       )
41.     )
42.   )
43.   (if Closed (vla-put-closed obj Closed))
44.   obj
45. )

and next:

Code - Auto/Visual Lisp: [Select]

1. (vlax-for % *cd-Blocks*
2.   (if
3.     (not (cd:BLK_GetEntity (vla-get-Name %) nil))
4.     (cd:ACX_AddLWPolyline
5.       %
6.       (list (list 0 0)(list 1000 0)(list 1000 1000)(list 0 1000))
7.       T
8.     )
9.   )
10. )

... and REGEN command...

kojacek

[Lee Mac]

Consider the following example:

Code - Auto/Visual Lisp: [Select]

1. (defun c:revealblocks ( / doc lst )
2.     (vlax-for blk (vla-get-blocks (setq doc (vla-get-activedocument (vlax-get-acad-object))))
3.         (if
4.             (and
5.                 (= :vlax-false (vla-get-islayout blk))
6.                 (= :vlax-false (vla-get-isxref blk))
7.                 (null (wcmatch (vla-get-name blk) "`**"))
8.             )
9.             (progn
10.                 (setq lst nil)
11.                 (vlax-for obj blk (setq lst (cons obj lst)))
12.                 (cond
13.                     (   (null lst)
14.                         (vla-put-closed
15.                             (vlax-invoke blk 'addlightweightpolyline
16.                                '(0.0 0.0 1000.0 0.0 1000.0 1000.0 0.0 1000.0)
17.                             )
18.                             :vlax-true
19.                         )
20.                     )
21.                     (   (vl-every '(lambda ( x ) (= "AcDbAttributeDefinition" (vla-get-objectname x))) lst)
22.                         (foreach att lst
23.                             (vlax-invoke blk 'addline '(0.0 0.0 0.0) (vlax-get att 'insertionpoint))
24.                         )
25.                     )
26.                 )
27.             )
28.         )
29.     )
30.     (vla-regen doc acallviewports)
31.     (princ)
32. )
33. (vl-load-com) (princ)

[HasanCAD]

kojacek
Thnaks working perfect,

LEE
As usual, perfect, I faced the that case when the block is in  Xref I was searching to solve it.
but one thing after running the lisp and zoom Extents the block is out of view.

[Lee Mac]

but one thing after running the lisp and zoom Extents the block is out of view.

Are all drawing layers thawed?

[HasanCAD]

but one thing after running the lisp and zoom Extents the block is out of view.

Are all drawing layers thawed?

YES