Move attribute value after insert - Modify existing Lisp to use move parameter

[Strydaris]

Hey everyone,

 

Hopefully someone can shed some light on this for me.

 

I have a snippet of a function that someone wrote. I can't remember for the life of me who wrote it or where I got it from. I want to say the Autocad forums, but not 100% sure.

What it does is it inserts my simple block, then allows me to move the attributed text after insert and the insertion point remains where it is.

Below is the section of the code in my main Lisp

     (cond
	(
	 (setq blk (vlax-invoke
		      (vlax-get
			 (vla-get-ActiveLayout
			    (vla-get-activedocument
			       (vlax-get-acad-object)))
			 'Block)
		      'InsertBlock  ptcrv
		      blk2 1 1 1 ang))
	 (setq atb  (Car (vlax-invoke blk 'Getattributes)))
	 (vla-put-textstring atb (strcat hgtnew " HP"))
	 (princ "\n<< Pick point for text location >>")
	 (_NextTrick (trans (vlax-get atb 'TextAlignmentPoint) 0 1) atb)
	 (setq inserted (cons blk2 inserted)
	       )
	 )
	(
	 (and (setq str (eq (type ptcrv) 'STR))(eq ptcrv "U") inserted)
	 (vla-delete (car inserted))
	 (setq inserted (Cdr inserted)
	       counter (1- counter))
	 )
	(str (princ "\nNothing to UNDO"))
	)

 

After this run, it points to this subfunction to allow me to move the text around.

 

  (defun _NextTrick  (pt obj / end code pt2)
      (while
            (and (null end)
                 (setq p    (grread t 15 0)
                       code (car p)))
                 (cond
                       ((= 5 code)
                        (vlax-put
                              obj
                              'TextAlignmentPoint
                              (setq pt2 (trans (cadr p) 1 0)))
                        (setq pt pt2)
                        )
                       ((or (= 2 code) (= code 3))
                        (setq end T)))
                 )
      );defun

 

What I am looking for is whether or not I can modify this to use a dynamic blocks move parameter to grab it from.

While the code I posted works great, a few people in my office asked if we could add a rotate parameter so that they can rotate the attributed text to a different angle if they needed to.

The problem with this code above is that it will move the text, but the dynamic block parameters stay where they are and the attributed text can end up not aligning well with the dynamic block parameters.

I am not familiar with the vlax-get or vlax-put functions and havent found much, if any information on how they work. To my understanding they use the 'TextAlignmentPoint to move the attributed text around, but I can't find what other values can be used with vlax-get & vlax-put.

Can anyone help me out?

[BIGAL]

For rotation maybe use textalignmentpoint as pt1 then

 

(setq pt2 (getpoint pt1 "\nDrag angle  "))
(setq ang (angle pt1 pt2))
(vlax-put atb 'Rotation ang)

 

If you know the dynamic block parameters maybe can work out new angle so no user input.

 

[Strydaris]

@BIGAL

So the idea behind this lisp is to calculate grade points. The block it inserts is just an X with and attributed value in it. The X needs to be stationary after the block is inserted, but I use the subfunction above to let the user place the text where ever is best suited in relation to the X. Sometimes the drawings can get a little crowded. 

I use the angle between 2 selected values to determine the rotation of the inserted block. 

I was asked if I could add a rotation parameter to the block so that the text can be rotated after the fact, while keeping the X stationary and in place. I figured since I was adding a rotation that I could add a point move parameter as well and use that instead of the textalignmentpoint to move the text around on insert, but it's proving difficult. 

[BIGAL]

There is a lisp called dumpit.lsp, which dumps object properties, manually checking you had an attribute atb so a dump reveals lots of properties like rotation

 

#<VLA-OBJECT IAcadAttributeReference 000000006F85A260> atb attribute
(VLAX-DUMP-OBJECT ATB)
Property values :
;
;   Alignment = 4
;   Application (RO) = #<VLA-OBJECT IAcadApplication 000000002C14D890>
;   Backward = 0
;   Color = 5
;   Constant (RO) = 0
;   Database (RO) = #<VLA-OBJECT IAcadDatabase 0000000068B2A228>
;   Document (RO) = #<VLA-OBJECT IAcadDocument 0000000065E46108>
;   EntityName (RO) = "AcDbAttribute"
;   EntityTransparency = "ByLayer"
;   EntityType (RO) = NIL
;   FieldLength = 0
;   Handle (RO) = "D999"
;   HasExtensionDictionary (RO) = 0
;   Height = 7.0
;   HorizontalAlignment = 4
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 0000000068DED538>
;   InsertionPoint = (693.8875 56.125 0.0)
;   Invisible = 0
;   Layer = "DRGTEXT"
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   LockPosition (RO) = 0
;   MTextAttribute = 0
;   MTextAttributeContent = "PRELIMINARY DRAWING"
;   MTextBoundaryWidth = 0.0
;   MTextDrawingDirection = 1
;   Material = "ByLayer"
;   Normal = (0.0 0.0 1.0)
;   ObjectID (RO) = 2177275936
;   ObjectID32 (RO) = -2117691360
;   ObjectName (RO) = "AcDbAttribute"
;   ObliqueAngle = 0.0
;   OwnerID (RO) = 2177276448
;   OwnerID32 (RO) = -2117690848
;   PlotStyleName = "Color_5"
;   Rotation = 0.0
;   ScaleFactor = 1.0
;   StyleName = "Standard"
;   TagString = "DRAWING_STATUS"
;   TextAlignmentPoint = (742.1875 59.625 0.0)
;   TextGenerationFlag = 0
;   TextString = "PRELIMINARY DRAWING"
;   Thickness = 0.0
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 0000000068B2E848>
;   UpsideDown = 0
;   VerticalAlignment = 0
;   Visible = -1
  

 

So you can GET and PUT properties

Edited September 16 by BIGAL

[Strydaris]

@BIGAL

So I have been playing around with getting this to work.

Someone over on the Autocad Forums has been helping me out a bit on it.

This is the updated code we have come up with.

  ;radians to degrees & degrees to radian
(defun RtD (r) (* 180.0 (/ r pi)))
(defun DtR (D) (/ (* D pi) 180))

(prompt "\nLoading Interpolate for siting & grading. Use the command ITRP to run. ")

(defun C:itrp ( / lay1 lay2 lay3 blk1 blk2 blk3 acadobj adoc msp activeundo txt dis newhgt ang1 grdtxt
		 tmpln inserted)

  ;;START COMMAND;;
  (vl-load-com)
  (setq OS (getvar "OSMODE")
	)
  (setq cl (getvar 'clayer))
  ;Set Layers and block names
  (setq lay1 "S-Slope-Frozen"
	lay2 "PROP-GRADE"
	lay3 "SLOPE-PH1"
	blk1 "DRAR"
	blk2 "Grade_Point"
	blk3 "PSEX"
	);End setq for varible layers and blocks
  (setvar 'clayer lay2)
  
  ;create  the layers if they do not exist
  (if (null (tblsearch "LAYER" lay1))
    (entmake
      (list
	'(0 . "LAYER")
	'(100 . "AcDbSymbolTableRecord")
	'(100 . "AcDbLayerTableRecord")
	'(70 . 0)
	(cons 2 lay1)
	(cons 62 222)
	(cons 290 0)
	)
      )
    );end if
  
(c:GetElevs)
     (setvar "OSMODE" 545)
   (SETQ pt3 (GETPOINT "\nSelect Interpolation point along the line: ")
	pt3 (list(car pt3)(cadr pt3) 0 )
	  )
;;****************DO THE MATH*****************;;
	(setq pm (/ (distance pt1 pt3)(distance pt1 pt2))
	      dis    (- hgt2 hgt1)
	      newhgt (+ hgt1 (* pm dis))
	      ang1   (+ (angle pt1 pt2)(angle '(0 0 0) (trans '(1 0 0) 1 0 t)))
	      grdtxt (rtos newhgt 2 2)
	      )
   (if (and (> ang1 (DtR 180))(< ang1 (DtR 360)))
	    (setq ang1 (+ (angle pt2 pt1)(angle '(0 0 0) (trans '(1 0 0) 1 0 t))))
      )
	    
   (cond
      ((setq blk (vlax-invoke
		    (vlax-get
		       (vla-get-ActiveLayout
			  (vla-get-activedocument
			     (vlax-get-acad-object)))
		       'Block)
		    'InsertBlock  (trans pt3 1 0)
		    blk2 1 1 1 ang1)
	     );_ setq
       ;Added this in for new move point
       (setq par (LM:getdynprops blk))
       (setq parx (cdr(assoc "Position1 X" par))
	     pary (cdr(assoc "Position1 Y" par))
	     )
       (setq ipt (vlax-get blk 'InsertionPoint)
	     iptx (car ipt)
	     ipty (cadr ipt)
	     pospt (trans (list (+ iptx parx) (+ ipty pary) 0.0) 0 1)
	     )
;End new move point
      (setq atb  (Car (vlax-invoke blk 'Getattributes)))
       (vla-put-textstring atb grdtxt)
       (princ "\n<< Pick point for text location >>")
       (_NextTrick pospt blk)
       (setq inserted (cons blk inserted)
	     );_setq
       );_ cond 1
      ((and (setq str (eq (type pt3) 'STR))(eq pt3 "U") inserted)
       (vla-delete (car inserted))
       (setq inserted (Cdr inserted)
	     counter (1- counter))
       );_cond 2
      (str (princ "\nNothing to UNDO")
       )
      );_ end cond

(if tmpln (entdel tmpln))
(setvar "OSMODE" OS)
(setvar 'clayer cl)
(prompt "\nInterpolate point equation: ")
   (prompt "\nInterpolated Value = (Required Distance From LP / Total Distance) X (Grade Value 1 - Grade Value 2) + Low Grade Value")
   (prompt (strcat "\n" grdtxt " = ((" (rtos (distance pt1 pt3) 2 4) " / " (rtos (distance pt1 pt2) 2 4) ") x (" (rtos hgt2 2 2)" - " (rtos hgt1 2 2) ")) + " (rtos hgt1 2 2)")"))
  (princ)
  
  )

  (defun _NextTrick  (pt obj / end code );pnt2 pnt3 pnt)
      (while
            (and (null end)
                 (setq p    (grread t 15 0); T=track 15=allkeys added up 0=curser type to display crosshairs
                       code (car p)));This gets the code for the tracking for the while loop
                 (cond
                       ((= 5 code)
			(LM:setdynpropvalue blk "Position1 X" (setq pnt2 (car (cadr p)) ))
		     	(LM:setdynpropvalue blk "Position1 Y" (setq pnt3 (cadr (cadr p)) ))
			(setq pnt (list pnt2 pnt3))
                        )
                       ((or (= 2 code) (= code 3));checks if the mouse is still tracking and hasnt clicked or keyboard entry yet
                        (setq end T)));If above happened, end the while loop
                 )
      );defun      

(defun LM:getdynprops ( blk )
    (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value)))
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)
;; Set Dynamic Block Property Value  -  Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil

(defun LM:setdynpropvalue ( blk prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)

 

Everything seems to work ok except for a few issues.

1. When the code gets to the _NextTrick portion it seems as though the grread section is double the XY values of the insertion point. Meaning if I insert the block at 50, 50, 0 and leave my cursor there, the attributed text is floating at 100, 100, 0.

2. If there is a rotation on the block on insert, the Position1 X & Y values of the dynamic block also rotate. Meaning that if my block is rotated 90 degrees on insert, the Position1 Y value becomes an X value in the negative. So if I move my cursor up, the attributed text moves to the left.

It almost seems as though the _NextTrick is moving things based on the blocks relationship to 0,0,0 rather than its relationship to the current UCS.

I was hoping the maybe @Lee Mac might have some insight on this strange behaviour.

[Lee Mac]

Have you checked whether or not the dynamic parameters "Position1 X" and "Position1 Y" are relative to the base point of the block definition or the insertion point of the block reference?

[Strydaris]

Hi Lee,

 

The points I am getting back are relative to the Base point.

Using your LM:getdynprops, this is what I am getting returned.

 

I then use this section of code to take get the initial point of the Postion1 parameter.

       (setq par (LM:getdynprops blk))
       (setq parx (cdr(assoc "Position1 X" par))
	     pary (cdr(assoc "Position1 Y" par))
	     )
       (setq ipt (vlax-get blk 'InsertionPoint)
	     iptx (car ipt)
	     ipty (cadr ipt)
	     pospt (trans (list (+ iptx parx) (+ ipty pary) 0.0) 0 1)
	     )

 

[Strydaris]

komondormrex over on the Autocad Forums came up with a solution for me.

Figured I would post it here in case someone else is looking for the same thing.

 

(defun _NextTrick  (blk / end code pt2)
      (while
            (and (null end)
                 (setq p    (grread t 15 0)
                       code (car p)))
                 (cond
                       ((= 5 code)
			(setq hypotenuse (distance (vlax-get blk 'insertionpoint) (cadr p)))  
			(vla-put-value (nth 2 (vlax-invoke blk 'getdynamicblockproperties))
			  		(* -1 hypotenuse (cos (- (angle (cadr p) (vlax-get blk 'insertionpoint))
							      		(vlax-get blk 'rotation)
							   )
						      )
					)
			)
			(vla-put-value (nth 3 (vlax-invoke blk 'getdynamicblockproperties))
			  		(* -1 hypotenuse (sin (- (angle (cadr p) (vlax-get blk 'insertionpoint))
							                (vlax-get blk 'rotation)
						       	   )
						      )
					)
			)
                        )
                       ((or (= 2 code) (= code 3))
                        (setq end T)))
                 )
      )