Topic: scale base points based on current cannoscale setting

[tdeleske]

Hello, I am looking for help to modify lisp code that places text at various insertion points, I have been searching for some code that will help me to scale the base points based on the current annotation value.
the routine is working perfect at 1:5000 but when inserting at any other scale is not what is needed because the base points are static in the code,  asking for help to scale the base point coordinates from the insertion points from the cannoscale.

specifically I have one insertion point to start and six base points for the text insertion.

lisp is attached.
function is "BCLabelUnitQuarters"

thank you

Trevor

[Aidarlife]

I am really wanting to know about this.

[tombu]

Simple lisp to set Text Size to 0.1 at current annotation scale using (/ 0.1 (getvar 'cannoscalevalue)) rather than dimension scale example:

Code: [Select]

;| Text size - This one you can get text size by picking text, entering a value, picking two points,
    or it will calculate it from CANNOSCALEVALUE if in Model Space.  It doesn't change on Escape.
   (load "TXTsize.LSP") tas ;
   by: Tom Beauford
   Leon County Public Works Engineering
===============================================|;
(defun C:tas (/ *error* vars tnt ts txt etp style)
  (setq vars (mapcar '(lambda (x) (cons x (getvar x))) '("luprec" "modemacro" "cmdecho")))
  (defun *error* (msg)
    ;; Reset variables
    (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars)
    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (setvar "luprec" 8)
  (setvar "cmdecho" 0)
  (grtext -1 "Select Text, Mtext or Attribute. Enter for more Options.")
  (setq tnt(nentsel "\nSelect Text Entity: "))
  (cond
((= 1 (getvar "cvport"))(setq ts "0.1"))
((= 1 (getvar "TILEMODE"))(setq ts (rtos(/ 0.1 (getvar 'cannoscalevalue))2 3)))
(T(setq ts (rtos(/(caddr (trans '(0 0 1) 3 2))10)2 3)))
  )
  (if (= "0" (substr ts (strlen ts)))
    (while (= (atof ts)(atof (substr ts 1 (- (strlen ts)1))))
      (setq ts(substr ts 1 (- (strlen ts)1)))
    );while
  );if
  (setq txt (strcat"\nChange Text Size from " (rtos(getvar "textsize")) " to :<" ts "> "))
  (if tnt (setq etp (cdr(assoc 0 (entget(car tnt))))))
  (if (or(= "TEXT" etp)(= "MTEXT" etp)(= "ATTRIB" etp))
    (progn
      (setq style (getvar "textstyle")
            style (tblobjname "style" style)
            xdata (cadr (assoc -3 (entget style '("AcadAnnotative"))))
            tnt(cdr(assoc 40 (entget (car tnt))))
      );setq
      (if(and xdata (= (cdr (nth 4 xdata)) 1))
        (setq tnt(* tnt (getvar "cannoscalevalue")))
      );if
    );progn
    (progn
      (grtext -1 "Enter Size, Pick 2 Points or Accept Default.")
      (setq tnt (getdist txt))
    );progn
  );if
  (if (or(= tnt nil)(= tnt 0.0))
    (setq tnt (atof ts))
  );if
    (setvar "textsize" tnt)
  (setq tnt (rtos(getvar "textsize")))
  (if (= "0" (substr tnt (strlen tnt)))
    (while (= (atof tnt)(atof (substr tnt 1 (- (strlen tnt)1))))
      (setq tnt(substr tnt 1 (- (strlen tnt)1)))
    );while
  );if
  (mapcar '(lambda (x) (setvar (car x) (cdr x))) vars)
  (grtext -1 "") ;Clear status line
  (vl-cmdf "redraw")
  (princ)
)