To box , and offset to an ATTRIBUTE

devitg · ‎06-25-2020

Hi all forum members, I'm dealing with this task .

To box a text string ATT, and offset it and so on.

I can not get the way to get such LWpolyline coordinates to make it.

Up now, I do this

As a matter of my way to do, I want to do it by VL-functions

Hope you could help me

Thank in advance

(DEFUN TO-BOX-AN-ATT  (/
                       ACAD-OBJ
                       ADOC
                       ATT-HEIGHT
                       BLK
                       BLK-ATT
                       BLK-ATT-INSPT
                       BLK-ATT-ROT
                       BLK-OBJ
                       BLK-SS
                       BOUNDING-ANG
                       BOUNDING-HEIGHT
                       BOUNDING-WIDE
                       MAXI
                       MAXI-XY
                       MINI
                       MINI-XY
                       MODEL
                       OFF-BOX
                       POLY-OBJ
                       )

  (VL-LOAD-COM)
  (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT))  
  (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) 
  (SETQ MODEL (VLA-GET-MODELSPACE ADOC))


  (PRINC "\n select the block")
  (SETQ BLK-SS (SSGET "_:S+." '((0 . "insert"))))
  (SETQ BLK (SSNAME BLK-SS 0))
  (SETQ BLK-OBJ (VLAX-ENAME->VLA-OBJECT BLK))

  (SETQ BLK-ATT (CAR (VLAX-INVOKE BLK-OBJ 'GETATTRIBUTES)))

  (SETQ BLK-ATT-INSPT (VLA-GET-INSERTIONPOINT BLK-ATT))
  (SETQ BLK-ATT-ROT (VLA-GET-ROTATION BLK-ATT))
  (SETQ ATT-HEIGHT (VLA-GET-HEIGHT BLK-ATT))
; up now I got this 
  (VLA-GETBOUNDINGBOX BLK-ATT 'MINI 'MAXI)

  (SETQ MINI-XY (VLAX-SAFEARRAY->LIST MINI))
  (SETQ MAXI-XY (VLAX-SAFEARRAY->LIST MAXI))

  (SETQ BOUNDING-ANG (ANGLE MINI-XY MAXI-XY))
  (SETQ BOUNDING-WIDE (ABS (- (CAR MINI-XY) (CAR MAXI-XY))))
  (SETQ BOUNDING-HEIGHT (ABS (- (CADR MINI-XY) (CADR MAXI-XY))))
 ; how to follow????????????????
 ; to make the lwpolyline
 ; i want to do it by VL-functions 

  ;; once its done 

  ;; offset 

  (SETQ OFF-BOX (VLA-OFFSET POLY-OBJ (* 0.25 ATT-HEIGHT)))
  (VLA-PUT-COLOR OFF-BOX ACRED)
  (VLA-PUT-LINEWEIGHT OFF-BOX 1)
  (VLA-DELETE POLY-OBJ)
  )
 ;|«Visual LISP© Format Options»
(180 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T)
;*** DO NOT add text below the comment! ***|;

Find attached the DWG sample

Sea-Haven · ‎06-25-2020

Will have to look for it again VLA-ADDPOLYLINE reads a safearray of points from memory.

here it is https://www.afralisp.net/archive/methods/list/addpolyline_method.htm

pbejse · ‎06-25-2020

@devitg wrote:

how to follow???????????????? ; to make the lwpolyline ; i want to do it by VL-functions ;; once its

After you acquire the coordinates

(vla-AddPolyline model
               (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbDouble '(0 . 14))
                 (append ll ul ur lr ll)
                 )
               )

Or are you also looking for help to acquire the coordinates?

pbejse · ‎06-25-2020

I wouldnt go with

(VLA-GETBOUNDINGBOX BLK-ATT 'MINI 'MAXI)

Unreliable results, especially rotated objects, use textbox function.

(setq blk-att-inspt (vlax-get blk-att 'insertionpoint))
  
(setq stringWidth
       (   (lambda ( box ) (- (caadr box) (caar box)))
            (textbox
                (list
	            (cons 01 (vlax-get blk-att 'Textstring))
	            (cons 40 att-height)
	            (cons 07 (vlax-get blk-att "StyleName"))
	        )
            )
        )
   )
(setq 2nd&4 (mapcar '(lambda (a m)
               (polar blk-att-inspt (+ blk-att-rot a) m))
                     (list (/ pi 2.0) 0 )
                     (list  att-height stringWidth)
                           )
        3rd  (polar (Car 2nd&4) blk-att-rot stringWidth)
        )
  
(setq poly-obj
       (vla-AddPolyline model
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbDouble '(0 . 14))
         (append blk-att-inspt  (cadr 2nd&4 )
                 3rd  (car 2nd&4) blk-att-inspt)
         )
       )
      )
(setq  off-box (Car (vlax-invoke poly-obj 'offset  (* 0.25 att-height))))  
(vlax-put off-box 'COLOR  ACRED)
(vlax-put off-box 'Lineweight -1)
(vla-delete poly-obj)

HTH

Im sure you have your reasons but you are not limited to using Vla-get to conform with VL functions rule, using vlax-get gives the user an easily recognizable value and not a variant - no conversion necessary...

(SETQ BLK-ATT-INSPT (VLA-GET-INSERTIONPOINT BLK-ATT))
#<variant 8197 ...>
(vlax-safearray->list (variant-value BLK-ATT-INSPT))
(2880.55 1517.93 0.0) 
  
(setq blk-att-inspt (vlax-get blk-att 'insertionpoint))
(2880.55 1517.93 0.0)

Sea-Haven · ‎06-25-2020

This could be replaced (SETQ BLK (SSNAME BLK-SS 0)) with nentsel pick attribute as only 1 block and 1 attribute are having box added.

Sea-Haven · ‎06-25-2020

I thought would change to nentsel. Sorry not tested no cad at moment.

(DEFUN c:TO-BOX-AN-ATT  (/
                       ATT-HEIGHT
                       BLK-ATT
                       BLK-ATT-INSPT
                       BLK-ATT-ROT
					   BLK-HEIGHT
                       MODEL
                       OFF-BOX
                       POLY-OBJ
                       )

(VL-LOAD-COM)
  
(SETQ MODEL (VLA-GET-MODELSPACE (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT))))

(while (setq ent (nentsel "\nPick Block Attribute"))
  
(SETQ BLK-att (VLAX-ENAME->VLA-OBJECT (car ent)))
  
(SETQ BLK-ATT-ROT (VLA-GET-ROTATION BLK-ATT))
  (SETQ ATT-HEIGHT (VLA-GET-HEIGHT BLK-ATT))

(setq blk-att-inspt (vlax-get blk-att 'insertionpoint))
  
  
(setq stringWidth
       (   (lambda ( box ) (- (caadr box) (caar box)))
            (textbox
                (list
	            (cons 01 (vlax-get blk-att 'Textstring))
	            (cons 40 (VLA-GET-HEIGHT BLK-ATT))
	            (cons 07 (vlax-get blk-att "StyleName"))
	        )
            )
        )
)

(setq 2nd&4 (mapcar '(lambda (a m)
               (polar blk-att-inspt (+ blk-att-rot a) m))
                     (list (/ pi 2.0) 0 )
                     (list  att-height stringWidth)
                           )
        3rd  (polar (Car 2nd&4) blk-att-rot stringWidth)
)
  
(setq poly-obj
       (vla-AddPolyline model
       (vlax-safearray-fill
         (vlax-make-safearray vlax-vbDouble '(0 . 14))
         (append blk-att-inspt  (cadr 2nd&4 )
                 3rd  (car 2nd&4) blk-att-inspt)
         )
       )
)
	  
(setq  off-box (Car (vlax-invoke poly-obj 'offset  (* 0.25 att-height)))) 

  (VLA-PUT-COLOR OFF-BOX ACRED)
  (VLA-PUT-LINEWEIGHT OFF-BOX -1)
  (VLA-DELETE POLY-OBJ)
  
)

  (princ)
)
 (c:TO-BOX-AN-ATT)

devitg · ‎06-26-2020

@pbejse Hi ,

@pbejse wrote:
@devitg wrote:
how to follow???????????????? ; to make the lwpolyline ; i want to do it by VL-functions ;; once its
After you acquire the coordinates

(vla-AddPolyline model
               (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbDouble '(0 . 14))
                 (append ll ul ur lr ll)
                 )
               )

Or are you also looking for help to acquire the coordinates?

Yes, of course, coordinates is the problem

devitg · ‎06-26-2020

@Sea-Haven , the SSGET is used as it is part of a whole automation task , with, almost, no user intervention.

There are about 6000 Blk-References

pbejse · ‎06-26-2020

@devitg wrote:

..Yes, of course, coordinates is the problem

I realized that after i posted the question, Did you try the snippet i posted right after that?

Hope it helps.

devitg · ‎06-26-2020

@pbejse , Hi , Yes, I'm on it.

Seem to work , I have to fit it, to my need.

Sea-Haven · ‎06-26-2020

If you want to do lots of blocks would it be better to go down the edit the block definition then attsync ? There is another post about add text mask to attribute.

Sea-Haven · ‎06-27-2020

I have been playing with this and textframe is supported for mtext, the advantage is the box redraws if text is changed, the issue here is that a pline is being drawn around attribute, change the att value box does not update.

A possible method is to have Mtext in block with attribute invisible use the property of the attribute as the mtext value.

Ok next problem as I found out on another post when you use this method in master block it reads the master attribute object id so the mtext does not update when inserting, I wrote a lisp that reads the current block att id and reads the value setting the property correctly for the individual block. I thought I read somewhere here about setting the frame around the attribute.

This was add 3 atts display total in 4th att.

(defun c:test ( / obj lst x str)
(setq oldatt (getvar 'attdia))
(setvar 'attdia 0)
(command "-insert" "test" (getpoint "\npick point") 1 1 0 (getstring "\nEnter Att1 ") (getstring "\nEnter Att2 ") (getstring "\nEnter Att3 ") "-")
(setq obj (vlax-ename->vla-object (entlast)))
(setq lst '())
(foreach att(vlax-invoke obj 'getattributes)
(princ  "\n")
(setq lst (cons  (strcat "%<\\AcObjProp Object(%<\\_ObjId " 
(vlax-invoke-method (vla-get-Utility  (vla-get-activedocument (vlax-get-acad-object))) 'GetObjectIdString att :vlax-false)
">%).Textstring>%"
 ) lst ))
)
(setq str nil)
(setq x (length lst))
(setq str (strcat "%<\\AcExpr ("
(nth (setq  x (- x 1)) lst) "+"
(nth (setq  x (- x 1)) lst) "+"
(nth (setq  x (- x 1)) lst) ")>%"
)
)
(setq x 1 y 4)
(foreach att(vlax-invoke obj 'getattributes)
(if (= x y)
(Vla-put-textstring att str)
)
(setq x (+ x 1))
)
(setvar 'attdia oldatt)
(princ)
)
(c:test)

Community

To box , and offset to an ATTRIBUTE

To box , and offset to an ATTRIBUTE

To box , and offset to an ATTRIBUTE