0 Members and 1 Guest are viewing this topic.
;* Permission to use copy or modify this;* program is hereby granted, and is supplied;* on an "as is" basis.;* ;* Designed by SYD Derbyshire - dec 03;*;*;* C:VPSCALE Adds scale annotation in text style TITLE;* (font Swiss 721 Black Extended BT) 3.5mm high, in layer VP-TEXT,;* 7.5mm below paper space viewport, centred to viewport.;* User can then edit to add viewport annotation. (defun *error* () (terpri) );* ------------------------------------------------------------ SUBROUTINE ------------------------------------------------------------ (defun MTWINDOW (/);---declare subroutine function with no arguments or global variables (setq xM (car mid#vpbaseline));---get X value of midpoint (setq yM (cadr mid#vpbaseline));---get Y value of midpoint (setq TLx (- xM 125));---assign X value to Top Left point variable (setq TLy yM);---assign Y value to Top Left point variable (setq BRx (+ xM 125));---assign X value to Bottom Left point variable (setq BRy (- yM 15));---assign Y value to Bottom Left variable (setq TL (list TLx TLy));---construct Top Left point of box (setq BR (list BRx BRy));---construct Bottom Right point of box );---end function ;* ----------------------------------------------------------- MAIN PROGRAM ----------------------------------------------------------- (defun C:VPS (/ osm oldsty oldht vpobj etxt vpscale#denom vpscale#num vpscale#factor vpscale#string vpscale mid#vpbaseline xM yM TLx TLy BRx BRy TL BR);---declare no arguments, and global variable list;---Test for Model Space (if (= (getvar "TILEMODE") 1) (progn (alert "Not allowed in Model Space")(exit);---issue message in Alert Box if in Model Space );---end progn );---end if (setvar "CMDECHO" 0);---prevent command line echo of commands called from program (setq osm (getvar "OSMODE"));---store existing object snap values (setq oldsty (getvar "TEXTSTYLE"));---store existing text style (setq oldlay (getvar "CLAYER"));---store existing layer name (setq oldht (getvar "TEXTSIZE"));---store existing text height (setvar "OSMODE" 0);---set object snap to zero (setvar "TEXTSIZE" 3.5);---set text height to 3.5 (command "-STYLE" "TITLE" "swissek.ttf" "0" "0.8" "" "" "");---define text style and make current (command "-LAYER" "M" "VP-TEXT" "C" "7" "" "LW" 0.25 "" "PS" "mono" "" "");---make new layer and set current;---LOOP to ensure selection of VIEWPORT object only (while (not (= (cdr (assoc 0 (entget (car (setq vpobj (entsel "\nSelect Viewport to annotate: ")))))) "VIEWPORT")) (prompt "\nSelect a Viewport ONLY please: ") );---end while loop (setq etxt (entget (car vpobj)));---store symbol table for object selected (setq vpscale#denom (cdr (assoc 41 etxt)));---base scale factor (setq vpscale#num (cdr (assoc 45 etxt)));---scale factor value (setq vpscale# (/ vpscale#num vpscale#denom));---returns absolute viewport scale as integer (setq vpscale#factor vpscale#);---record absolute viewport scale (if (< vpscale#factor 1)(setq vpscale#factor (/ 1 vpscale#factor)));---sets viewport scale to real (setq vpscale#string (rtos vpscale#factor));---returns string value of viewport scale;---Test absolute scale factor value and set string to reflect scale value correctly (cond ((< vpscale# 1)(setq vpscale (strcat "SCALE " vpscale#string ":1"))) ;((> (- vpscale# (fix vpscale#)) 0)(setq vpscale "N.T.S.")) ((>= vpscale# 1)(setq vpscale (strcat "SCALE 1:" vpscale#string))) ) (setvar "OSMODE" 2);---set object snap to MIDPOINT (setq mid#vpbaseline (getpoint "\nSelect midpoint Viewport base line: "));---user select midpoint of viewport baseline (terpri) (setvar "OSMODE" 0);---delimit object snap (MTWINDOW);---subroutine calculation of MTEXT window points see SUBROUTINE (command "-MTEXT" TL "J" "MC" BR vpscale "") (princ);---RESET environment (setvar "OSMODE" osm) (setvar "TEXTSTYLE" oldsty) (setvar "CLAYER" oldlay) (setvar "TEXTSIZE" oldht) (princ) );---end function
now working in 2002 urrrrgrh
. The tricky thing is that sometimes when i scale viewports i do it in architectural units (1-1/2"=1'-0" and other times in i guess civil? 1:8 ) so the routine would need to read both. Is this an easy thing to do or no. Maaaan I can't wait until they upgrade here ugggggh