How to set annotation scale of the viewport with Visual Lisp

With Visual Lisp you can to set many properties of viewports objects but not annotation scale. There is not much resources about it, I found the routine: using lisp to set annotation scale for a viewport which uses ObjectARX to work around lisp limitations but because my lack of C++ skills it didn’t satisfy me.

I found out that if the annotation scale of viewport is set, the reference data is stored in the xRecord named  ASDK_XREC_ANNOTATION_SCALE_INFO in the extension dictionary attached to the viewport object. Let’s extract information stored in the xRecord and look closer to data stored in:

(setq	vpDict (vla-GetExtensionDictionary vpObj)							;get extension dictionary of viewport object
		vpXrec (vla-item vpDict "ASDK_XREC_ANNOTATION_SCALE_INFO")	;get xRecord "ASDK_XREC_ANNOTATION_SCALE_INFO"
);setq
(vla-GetXrecordData vpXrec 'dxfCodes 'dxfData)							;get the xRecord data

This is only essential part of the code, there is no error catches and you need to keep in mind that xRecord  ASDK_XREC_ANNOTATION_SCALE_INFO is present only in viewport objects where annotation scale property is set, otherwise an error will occur inside vla-item function.

After extracting raw variant values we get:

nth dxfCodes dxfData
0 90 1
1 340 (-9415280 -69366291)

I’m not sure what 90 code stands for, but Autocad doesn’t like when it’s been changed ;).

The goodies are in the 340 code. It stores hardpoint link to scale object under ACAD_SCALELIST dictionary in the main drawing dictionary but how to decode those numbers? Let’s extract same data with vanilla lisp:

(setq vpEnt (handent "22E")								;viewport object
		vpDxf (entget vpEnt)									;group codes of the object
		vpDictDxf (entget(cdr(assoc 360 vpDxf)))		;group codes of extension dictionary of the object
		vpXrecDxf (entget(cdr(assoc 360 vpDictDxf)))	;group codes of the xRecord
);setq

Here is the content of vpXrecDxf:

(-1 . <Entity name: 7ffff705b80>)
(0 . XRECORD)
(5 . 230)
(102 . {ACAD_REACTORS)
(330 . <Entity name: 7ffff705b70>)
(102 . })
(330 . <Entity name: 7ffff705b70>)
(100 . AcDbXrecord)
(280 . 1)
(90 . 1)
(340 . <Entity name: 7ffff705590>)

As you can see, it’s an entity name, but because it’s impossible to modify vpXrecDxf group codes with  subst; entmod functions I tried to find the way to decode the list of longs. I found this post according to, the list of numbers is probably the objectID represented in two 32 longs. I stucked here because I didn’t find any hints how to convert ename to objectID in that odd notation.

After analysis of drawing saved in plain dxf format you can see that 340 group code contains handle of the linked object. So maybe instead of struggling with the objectID numbers let’s put handle string in the xRecord data? Bingo! As I wrote before it cannot be done with vanilla lisp, but Visual Lisp methods works like a charm 🙂

The routine below explains what’s going on step by step:

;===================================================================================
;		mc-setAnnoScale - routine sets the annotation scale of viewport object			
;																												
;				_obj <ENAME/VLA-OBJECT> - viewport object to set the scale					
;				_sc <STR/REAL> 			- scale description or factor							
;																												
;					EXAMPLE OF USE: (mc-setAnnoScale (car(entsel)) "1:50")					
;===================================================================================
(defun mc-setAnnoScale ( _obj _sc / scHand dC1 dC2 vpDict vpXrec dxfCodes dxfData toTurnOn)
	;-------------validate provided scale-------------
	(if (setq scHand (mc-findScale _sc))	;follow to the next function
		(setq dC1 T)
	);if
	;-------------validate picked object-------------
	(cond
		((= (type _obj) 'ENAME)
		 (setq vpObj (vlax-ename->vla-object _obj)
				 dC2 T
		 );setq
		);ENAME
		((= (type _obj) 'VLA-OBJECT)
		 (setq vpObj _obj
				 dC2 T
		 );setq
		);VLA-OBJECT
		(T nil)
	);cond
	(if
		(and
			dC1
			dC2
			(= "AcDbViewport" (vla-Get-ObjectName vpObj))
		);and
		(progn
			(setq	vpDict (vla-GetExtensionDictionary vpObj)																;get extension dictionary of viewport object
					vpXrec (vl-catch-all-apply 'vla-item(list vpDict "ASDK_XREC_ANNOTATION_SCALE_INFO"))	;get xRecord "ASDK_XREC_ANNOTATION_SCALE_INFO"
			);setq
			;-------------if viewport is inserted in active layout-------------
			(if (=
					(getvar "CTAB")
					(vla-get-name
						(vla-get-layout
							(vla-objectidtoobject
								(vla-get-ActiveDocument (vlax-get-acad-object))
								(vla-get-ownerid vpObj)
							)
						)
					)
				 )
				(progn
					(vla-put-ViewPortOn vpObj :vlax-false)			;turn off viewport display
					(setq toTurnOn T)
				);progn
			);if
			(if (vl-catch-all-error-p vpXrec)
				;-------------if there is no xRecord "ASDK_XREC_ANNOTATION_SCALE_INFO" then add it and fill it with desired values-------------
				(progn
					(setq vpXrec (vla-AddXrecord vpDict "ASDK_XREC_ANNOTATION_SCALE_INFO")		;add xRecord to dictionary
							dxfCodes (vlax-make-variant														;make and fill safearray with dxf codes of xRecord
											(vlax-safearray-fill
												(vlax-make-safearray vlax-vbInteger '(0 . 1))
												'(90 340)
											);vlax-safearray-fill
										);vlax-make-variant
							dxfData (vlax-make-variant															;make and fill safearray with dxf data of xRecord
											(vlax-safearray-fill
												(vlax-make-safearray vlax-vbVariant '(0 . 1))
												(list 1 scHand)
											);vlax-safearray-fill
										);vlax-make-variant
					);setq
					(vla-SetXrecordData vpXrec dxfCodes dxfData)			;set the xRecord data
				);progn
				;-------------if there is the xRecord "ASDK_XREC_ANNOTATION_SCALE_INFO" then change the value of scale object reference-------------
				(progn
					(vla-GetXrecordData vpXrec 'dxfCodes 'dxfData)		;get the xRecord data
					(vlax-safearray-put-element dxfData 1 scHand)		;put the scale object handle in the right place
					(vla-SetXrecordData vpXrec dxfCodes dxfData)			;and save the new values in the xRecord
				);progn
			);if
			;-------------if viewport display was turned off-------------
			(if toTurnOn
				(vla-put-ViewPortOn vpObj :vlax-true)						;turn on viewport display
			);if
		);progn
		
		;-------------if error occured during validation show the message-------------
		(princ "\nScale provided not found in the drawing or picked object is not AcDbViewport")
	);if
	(princ)
);defun


;===================================================================================
;		mc-findScale - check if provided scale is present in the drawing					
;																												
;			anSc <STR/REAL> 	- scale description or factor										
;			RetVal <STR/nil> 	- if found then return handle of the object otherwise nil
;																												
;					EXAMPLE OF USE: (mc-findScale "1:50") or (mc-findScale 0.02)			
;===================================================================================
(defun mc-findScale ( anSc / scDict i doCont scHand)
	(setq scDict (dictsearch (namedobjdict) "ACAD_SCALELIST")	;dictionary with scales
			i 0																	;loop counter
			doCont T																;loop execution marker
	);setq
	(while (and
				 doCont
				 (< i (length scDict))
			 );and
		(if (= 3 (car(nth i scDict)))
			;-------------if it's name of scale object-------------
			(progn
				(setq scEnt (entget(cdr(nth (1+ i) scDict))))		;get the dxf codes of the entity
				(cond
					(
					 ;-------------if anSc is a name of scale (string) and the names are equal-------------
					 (and
						(= (type anSc) 'STR)
						(= anSc (cdr(assoc 300 scEnt)))
					 );and
						(setq scHand (cdr(assoc 5 scEnt))				;return the handle of scale object
								doCont nil										;exit the lopp
						);setq
					);#string
					(
					 ;-------------if anSc is a scale factor (number) and the factors are equal-------------
					 (and
						(numberp anSc)
						(= anSc (/ (cdr(assoc 140 scEnt)) (cdr(assoc 141 scEnt))))
					 );and
						(setq scHand (cdr(assoc 5 scEnt))
								doCont nil
						);setq
					);#number
					(T
					 (setq i (+ i 2))		;increment counter by 2 to get to the next scale entity
					)
				);cond
			);progn
			(setq i (1+ i))				;increment counter by 1
		);if
	);while
	
	;-------------return scale object handle or nil if not found-------------
	scHand
);defun

As you can see it’s quite easy. In the next post I will explain how to add custom scale into ACAD_SCALELIST dictionary, meanwhile take a look at the the function in action.

mc-setAnnoScale
mc-setAnnoScale

Leave a Reply

Your email address will not be published. Required fields are marked *