;;; --------------------------------------------------------------------------- ;;; AttSqueeze.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; Sets an attribute's WIDTH FACTOR by dragging, with the value shown live at ;;; the cursor. ;;; ;;; The usual reason is a title block field that will not fit - a long project ;;; name in a fixed-width box. Rather than guessing at width factors in the ;;; properties palette and re-checking each time, you drag until it fits and ;;; click. ;;; ;;; CONTROLS WHILE DRAGGING ;;; move the cursor sets the width factor ;;; TAB switch between continuous and stepped adjustment ;;; I set the step size (stepped mode only) ;;; R reset to the width factor of the block's attribute ;;; DEFINITION - that is, back to how the block was designed ;;; C or Escape cancel, restoring the original width ;;; click accept ;;; ;;; The mode and step size are remembered between AutoCAD sessions. ;;; ;;; Width factors are constrained to between 0.01 and 100, which is the range ;;; AutoCAD itself accepts; outside it the cursor readout turns red and no ;;; change is applied. ;;; ;;; SINGLE-LINE ATTRIBUTES ONLY. A multiline attribute has no width factor - ;;; it wraps instead - so those are refused at selection with an explanation. ;;; ;;; HOW THE DRAG WORKS ;;; The cursor's displacement from the attribute's base point is projected onto ;;; the attribute's own text direction, giving a distance along the text ;;; regardless of the direction the cursor moved. That distance is divided by ;;; the text's width at factor 1 - measured once at the start - to give the ;;; factor. Because the direction vector comes from the attribute's rotation, ;;; this works at any angle and in any construction plane. ;;; ;;; ATTSQUEEZE - set attribute width factor by dragging ;;; --------------------------------------------------------------------------- (vl-load-com) ;; Environment keys for the remembered settings. (setq AttSqueeze:ModeKey "YZ\\attsqueeze-mode" AttSqueeze:StepKey "YZ\\attsqueeze-step" ) ;; --------------------------------------------------------------------------- ;; AttSqueeze:Doc - cached active document ;; --------------------------------------------------------------------------- (defun AttSqueeze:Doc nil (eval (list 'defun 'AttSqueeze:Doc 'nil (vla-get-activedocument (vlax-get-acad-object)) ) ) (AttSqueeze:Doc) ) ;;; =========================================================================== ;;; PIXEL FONT FOR THE CURSOR READOUT ;;; ;;; grvecs draws vectors, not text, so displaying a number at the cursor means ;;; drawing every character stroke by stroke. The table below is a complete ;;; pixel font: one entry per character code, holding the vector pairs that ;;; draw it. ;;; ;;; Each number encodes a point as tens and units - 45 is x=5, y=4 - and the ;;; numbers are read in pairs as line segments. That compact encoding is why ;;; the table is readable at all; written as coordinate pairs it would run to ;;; several thousand lines. ;;; ;;; This is data, not logic. It needs no maintenance and is reproduced intact. ;;; =========================================================================== (defun AttSqueeze:GrText ( str / asc lst vec xco yco ) (setq vec '( (033 045 045 065 135) (034 104 134 107 137) (035 043 063 046 066 084 094 087 097 115 135 118 138 072 078 103 109) (036 025 035 052 052 043 047 058 078 083 087 092 112 123 127 118 118 135 135) (037 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129 047 048 067 068 056 056 059 059 113 114 133 134 122 122 125 125) (038 043 046 049 049 052 072 057 058 067 068 076 076 079 079 083 083 085 085 094 094 103 123 134 136 127 127) (039 105 135) (040 017 017 026 036 045 105 116 126 137 137) (041 014 014 025 035 046 106 115 125 134 134) (042 073 074 076 077 084 086 092 098 104 106 113 114 116 117) (043 055 115 082 084 086 088) (044 034 035 045 046 055 057) (045 083 088) (046 045 046 055 056) (047 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129) (048 044 047 134 137 053 123 058 128) (049 044 048 124 125 056 136) (050 043 048 053 053 064 064 075 075 086 086 097 097 108 128 134 137 123 123) (051 053 053 044 047 058 088 095 097 108 128 134 137 123 123) (052 046 048 057 137 078 078 073 076 083 083 094 094 105 115 126 126) (053 053 053 044 047 058 088 094 097 093 133 134 138) (054 044 047 058 088 095 097 084 084 053 113 124 124 135 137) (055 044 054 065 075 086 096 107 117 128 138 133 137 123 123) (056 044 047 094 097 134 137 053 083 058 088 103 123 108 128) (057 044 046 057 057 068 128 097 097 084 086 134 137 093 123) (058 045 046 055 056 095 096 105 106) (059 034 035 045 046 055 057 095 096 105 106) (060 047 047 056 056 065 065 074 074 083 083 094 094 105 105 116 116 127 127) (061 073 078 093 098) (062 043 043 054 054 065 065 076 076 087 087 096 096 105 105 114 114 123 123) (063 045 045 065 075 086 086 097 097 108 128 134 137 123 123) (064 034 038 043 043 052 112 123 123 134 137 128 128 079 119 068 068 065 066 105 106 077 107 074 094) (065 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134) (066 042 047 053 123 058 088 108 128 094 097 132 137) (067 044 047 053 053 058 058 062 112 123 123 134 136 127 127 108 138) (068 042 046 057 057 127 127 132 136 068 118 053 123) (069 042 048 058 058 094 095 086 106 132 137 128 138 053 123) (070 042 045 094 095 086 106 132 137 128 138 053 123) (071 044 047 053 053 058 078 086 089 062 112 123 123 134 136 127 127 108 138) (072 041 043 047 049 131 133 137 139 093 097 052 122 058 128) (073 043 047 133 137 055 125) (074 052 062 043 046 057 127 135 139) (075 042 044 048 049 132 134 136 138 053 123 084 085 095 095 106 116 127 127 076 076 067 067 058 058) (076 042 047 048 058 053 123 132 135) (077 041 043 047 049 052 122 058 128 131 132 138 139 103 113 107 117 084 094 086 096 065 075) (078 041 044 131 132 136 139 052 122 048 128 113 113 094 104 085 085 066 076 057 057) (079 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118) (080 042 045 084 087 132 137 053 123 098 128) (081 134 136 123 123 127 127 112 062 118 068 053 053 057 057 044 046 035 036 023 024 027 028) (082 042 044 048 049 132 137 123 053 128 098 084 087 076 076 067 067 058 058) (083 042 062 053 053 044 047 058 078 086 087 093 095 102 122 133 136 127 127 118 138) (084 043 047 055 125 132 138 131 121 139 129) (085 044 046 052 053 057 058 062 122 068 128 131 133 137 139) (086 045 055 064 074 066 076 083 103 087 107 112 122 118 128 131 133 137 139) (087 043 063 047 067 072 092 074 094 076 096 078 098 101 121 105 115 109 129 131 132 138 139) (088 041 043 047 049 131 133 137 139 052 052 058 058 063 063 067 067 074 074 076 076 085 095 104 104 106 106 113 113 117 117 122 122 128 128) (089 043 047 055 085 094 094 096 096 103 113 107 117 122 122 128 128 131 133 137 139) (090 122 122 058 058 132 138 042 048 128 128 052 052 063 063 074 074 085 095 106 106 117 117) (091 015 017 135 137 025 125) (092 122 122 113 113 104 104 095 095 086 086 077 077 068 068 059 059) (093 014 016 134 136 026 126) (094 102 102 113 113 124 124 135 135 126 126 117 117 108 108) (095 021 029) (096 125 125 134 134) (097 043 046 048 048 052 072 057 097 083 086 103 106) (098 042 043 045 046 054 054 057 058 068 098 097 097 105 106 094 094 132 132 053 133) (099 044 046 053 053 057 058 052 092 093 093 104 106 097 098 108 108) (100 044 045 047 048 052 092 053 053 056 056 093 093 104 105 096 096 136 136 057 137) (101 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078) (102 043 046 054 124 093 093 095 096 135 137 128 128) (103 013 016 022 032 027 097 107 108 066 066 096 096 054 055 104 105 063 063 093 093 062 092) (104 042 044 046 048 057 097 053 133 132 132 094 094 105 106) (105 043 047 055 105 103 104 135 135) (106 022 022 013 015 026 106 104 105 136 136) (107 042 044 046 048 053 133 132 132 057 057 066 066 074 075 085 085 096 106 107 108) (108 043 047 055 135 133 134) (109 041 043 045 046 048 049 052 102 055 105 058 108 101 101 093 093 104 104 096 096 107 107) (110 042 044 046 048 053 103 057 097 102 102 094 094 105 106) (111 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098) (112 012 015 023 103 102 102 054 054 094 094 045 046 105 106 057 058 097 098 068 088) (113 015 018 027 107 108 108 056 056 096 096 044 045 104 105 052 053 092 093 062 082) (114 042 046 054 104 102 103 095 095 106 108 099 099) (115 052 052 043 047 058 068 073 077 082 092 103 107 098 098) (116 045 047 058 058 054 124 102 103 105 107) (117 102 102 106 106 053 103 056 056 044 045 047 107 048 048) (118 045 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109) (119 043 053 047 057 062 092 064 084 066 086 068 098 101 103 095 105 107 109) (120 042 044 046 048 102 104 106 108 053 053 057 057 093 093 097 097 064 064 066 066 084 084 086 086 075 075) (121 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109) (122 092 092 058 058 102 108 042 048 097 097 086 086 075 075 064 064 053 053) (123 016 017 025 065 073 074 085 125 136 137) (124 015 135) (125 014 015 026 066 077 078 086 126 134 135) (126 112 122 133 134 125 125 116 117 128 138) (145 114 116 125 126 136 137) (146 114 115 125 126 135 137) (161 045 115 135 135) (162 026 036 045 047 058 058 054 054 053 093 094 094 098 098 105 107 116 126) (163 043 048 054 074 083 086 094 094 103 123 134 136 117 127) (164 083 083 088 088 133 133 138 138 094 097 124 127 104 114 107 117) (165 044 046 055 075 081 089 094 094 096 096 101 103 107 109 113 113 117 117 122 122 128 128 131 133 137 139) (166 015 055 095 135) (167 042 042 032 036 047 047 056 057 065 065 074 074 083 083 092 102 068 078 087 087 096 096 105 105 113 114 123 123 134 138 128 128) (168 134 134 137 137) (169 054 057 063 063 068 068 072 122 079 129 133 133 138 138 144 147 075 076 087 087 084 114 125 126 117 117) (170 063 067 084 086 088 088 093 103 097 127 114 116 134 136) (171 055 055 064 064 073 073 082 082 093 093 104 104 115 115 058 058 067 067 076 076 085 085 096 096 107 107 118 118) (172 068 098 092 097) (173 083 088) (174 054 057 063 063 068 068 072 122 079 129 133 133 138 138 144 147 074 124 095 096 125 126 077 087 107 117) (175 151 159) (176 105 106 114 124 117 127 135 136) (177 042 048 092 098 065 085 105 125) (178 084 087 095 095 106 106 117 127 135 136 124 124) (179 094 094 085 086 097 107 116 116 127 127 135 136 124 124) (180 125 125 136 136) (181 012 012 023 113 044 047 049 049 058 118) (182 045 045 049 049 048 128 046 126 133 139 122 125 112 115 102 105 092 095 083 085) (183 085 086 095 096) (184 014 015 026 026 035 035) (185 084 086 124 124 095 135) (186 063 067 084 086 134 136 093 123 097 127) (187 052 052 063 063 074 074 085 085 094 094 103 103 112 112 055 055 066 066 077 077 088 088 097 097 106 106 115 115) (188 048 098 059 059 055 057 065 065 076 076 087 087 083 133 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129) (189 046 049 057 057 068 068 079 089 097 098 086 086 083 133 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129) (190 048 098 059 059 055 057 065 065 076 076 087 087 092 092 083 084 095 105 114 114 125 125 133 134 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129) (191 044 047 058 058 053 073 084 084 095 095 106 116 136 136) (192 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 155 155 164 164) (193 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 155 155 166 166) (194 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 154 154 165 165 156 156) (195 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 152 152 163 165 155 157 168 168) (196 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 163 163 167 167) (197 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 145 145 154 154 165 165 156 156) (198 041 043 045 049 052 062 073 093 104 114 125 125 084 085 059 059 056 126 097 098 088 088 108 108 134 139 129 129) (199 044 047 053 053 058 058 062 112 123 123 134 136 127 127 108 138 014 015 026 026 035 035) (200 042 048 058 058 094 095 086 106 132 137 128 138 053 123 156 156 165 165) (201 042 048 058 058 094 095 086 106 132 137 128 138 053 123 155 155 166 166) (202 042 048 058 058 094 095 086 106 132 137 128 138 053 123 154 154 165 166 157 157) (203 042 048 058 058 094 095 086 106 132 137 128 138 053 123 164 164 167 167) (204 043 047 133 137 055 125 155 155 164 164) (205 043 047 133 137 055 125 155 155 166 166) (206 043 047 133 137 055 125 154 154 165 165 156 156) (207 043 047 133 137 055 125 163 163 167 167) (208 042 046 057 057 127 127 132 136 068 118 053 123 091 092 094 095) (209 041 044 131 132 137 139 052 122 048 128 113 113 094 104 085 085 066 076 057 057 152 152 163 165 155 157 168 168) (210 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 155 155 164 164) (211 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 155 155 166 166) (212 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 154 154 165 165 156 156) (213 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 152 152 163 165 155 157 168 168) (214 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 163 163 167 167) (215 052 052 063 063 074 074 085 085 096 096 107 107 118 118 058 058 067 067 076 076 094 094 103 103 112 112) (216 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 043 043 064 074 085 095 106 116 137 137) (217 044 046 052 053 057 058 062 122 068 128 131 133 137 139 155 155 164 164) (218 044 046 052 053 057 058 062 122 068 128 131 133 137 139 155 155 166 166) (219 044 046 052 053 057 058 062 122 068 128 131 133 137 139 154 154 165 165 156 156) (220 044 046 052 053 057 058 062 122 068 128 131 133 137 139 163 163 167 167) (221 044 046 055 085 094 094 096 096 103 113 107 117 122 122 128 128 131 133 137 139 145 155 166 166) (222 042 044 132 132 053 133 074 077 104 107 088 098) (223 042 042 043 123 134 136 107 127 095 096 087 087 058 078 045 047) (224 043 046 048 048 052 072 057 097 083 086 103 106 125 125 134 134) (225 043 046 048 048 052 072 057 097 083 086 103 106 125 125 136 136) (226 043 046 048 048 052 072 057 097 083 086 103 106 124 124 135 135 126 126) (227 043 046 048 048 052 072 057 097 083 086 103 106 122 122 133 134 125 126 137 137) (228 043 046 048 048 052 072 057 097 083 086 103 106 133 133 137 137) (229 043 046 048 048 052 072 057 097 083 086 103 106 125 125 134 134 145 145 136 136) (230 042 044 046 048 059 059 051 071 082 084 102 104 055 095 076 079 089 099 106 108) (231 014 015 026 026 035 035 044 046 053 053 057 058 052 092 093 093 104 106 097 098 108 108) (232 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 125 125 134 134) (233 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 125 125 136 136) (234 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 124 124 135 135 126 126) (235 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 133 133 137 137) (236 043 047 055 105 103 104 125 125 134 134) (237 043 047 055 105 103 104 124 124 135 135) (238 043 047 055 105 103 104 124 124 135 135 126 126) (239 043 047 055 105 103 104 133 133 136 136) (240 044 046 053 053 057 057 052 082 058 088 083 083 087 107 094 096 116 116 113 114 125 125 134 134 136 137) (241 042 044 046 048 053 103 057 097 102 102 094 094 105 106 122 122 133 134 125 126 137 137) (242 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 125 125 134 134) (243 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 125 125 136 136) (244 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 124 124 135 135 126 126) (245 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 122 122 133 135 125 127 138 138) (246 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 133 133 137 137) (247 055 055 115 115 082 088) (248 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 042 042 064 064 075 075 086 086 108 108) (249 102 102 106 106 053 103 056 056 044 045 047 107 048 048 125 125 134 134) (250 102 102 106 106 053 103 056 056 044 045 047 107 048 048 125 125 136 136) (251 102 102 106 106 053 103 056 056 044 045 047 107 048 048 124 124 135 135 126 126) (252 102 102 106 106 053 103 056 056 044 045 047 107 048 048 133 133 137 137) (253 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109 125 125 136 136) (254 012 015 132 132 023 133 054 054 045 046 057 058 068 088 094 094 105 106 097 098) (255 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109 133 133 137 137) ) ) ;; ----------------------------------------------------------------------- ;; This function REPLACES ITSELF on first call. The replacement carries the ;; table already decoded from its compact numeric form into coordinate ;; pairs, so the decoding happens once rather than on every frame of a drag ;; - which is what keeps the readout smooth. ;; ;; The decoding is simply: units digit is x, tens digit upward is y. ;; ----------------------------------------------------------------------- (eval (list 'defun 'AttSqueeze:GrText '( str / asc lst vec xco yco ) (list 'setq 'vec (list 'quote (mapcar (function (lambda ( b ) (cons (car b) (mapcar (function (lambda ( a ) (list (rem a 10) (/ a 10))) ) (cdr b) ) ) ) ) vec ) ) ) '(setq xco 0 yco 0) '(repeat (strlen str) (setq asc (ascii str) str (substr str 2) ) (cond ;; Space and tab advance the cursor without drawing. ( (= 32 asc) (setq xco (+ xco 09))) ( (= 09 asc) (setq xco (+ xco 36))) ;; Newline returns to the left and drops a line. ( (= 10 asc) (setq xco 0 yco (- yco 16))) ;; Anything else: offset the character's strokes to the ;; current position and advance by one character width. ( (setq lst (cons (mapcar (function (lambda ( a ) (list (+ (car a) xco) (+ (cadr a) yco))) ) (cdr (assoc asc vec)) ) lst ) ) (setq xco (+ xco 9)) ) ) ) '(apply 'append lst) ) ) (AttSqueeze:GrText str) ) ;; --------------------------------------------------------------------------- ;; AttSqueeze:ShowText ;; --------------------------------------------------------------------------- ;; Draws a vector string near the cursor, scaled so it stays the same apparent ;; size at any zoom - which is what the ratio of view size to screen size ;; computes. ;; ;; pnt - [list] cursor point, UCS ;; vec - [list] vector list from AttSqueeze:GrText ;; col - [int] ACI colour ;; xof - [int] horizontal offset from the cursor, in pixels ;; yof - [int] vertical offset, in pixels ;; --------------------------------------------------------------------------- (defun AttSqueeze:ShowText ( pnt vec col xof yof / scl ) (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize))) pnt (trans pnt 1 2) ) (grvecs (cons col vec) (list (list scl 0.0 0.0 (+ (car pnt) (* xof scl))) (list 0.0 scl 0.0 (+ (cadr pnt) (* yof scl))) (list 0.0 0.0 scl 0.0) '(0.0 0.0 0.0 1.0) ) ) ) ;; --------------------------------------------------------------------------- ;; AttSqueeze:DefinitionWidth ;; --------------------------------------------------------------------------- ;; Returns the width factor pair from the block's attribute DEFINITION matching ;; this attribute's tag, or nil. ;; ;; This is what the Reset option restores to - the width the block designer ;; intended, rather than a blanket 1.0. ;; ;; enx - [list] the attribute's entity data ;; --------------------------------------------------------------------------- (defun AttSqueeze:DefinitionWidth ( enx / blk tag tmx res ) (setq blk (tblobjname "block" (cdr (assoc 2 (entget (cdr (assoc 330 enx)))))) tag (strcase (cdr (assoc 2 enx))) ) (while (and (setq blk (entnext blk)) (null res)) (if (and (= "ATTDEF" (cdr (assoc 0 (setq tmx (entget blk))))) (= tag (strcase (cdr (assoc 2 tmx)))) ) (setq res (assoc 41 tmx)) ) ) res ) ;; --------------------------------------------------------------------------- ;; c:ATTSQUEEZE - main routine ;; --------------------------------------------------------------------------- ;; Note the original left its Reset result variable undeclared, leaking it ;; globally on every run; it is localised here. ;; --------------------------------------------------------------------------- (defun c:ATTSQUEEZE ( / *error* vars vals bpt ent enx fac flg gr1 gr2 inc prompt old res tmp vec wid cancelled ) ;; DIMZIN is set to 0 so rtos formats the readout without stripping ;; trailing zeros, which would make the number jitter in width as it ;; changes. (setq vars '("CMDECHO" "DIMZIN") vals (mapcar 'getvar vars) ) (defun AttSqueeze:Restore ( ) (redraw) ;; Settings are saved even on the error path, so a cancelled run does ;; not lose a mode or step the user just changed. (setenv AttSqueeze:ModeKey (if flg "1" "0")) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End") (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) ) (princ) ) (defun *error* ( msg ) ;; Escape means cancel, which must put the original width back - the ;; user was previewing, not committing. (if (and msg (wcmatch (strcase msg t) "*break*,*cancel*,*exit*") (numberp old) ent ) (entmod (list ent (cons 41 old))) ) (AttSqueeze:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** ATTSQUEEZE error: " msg " **")) ) (princ) ) (setvar "CMDECHO" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler ;; unless the routine says up front that it will use one. Restore does, ;; to close this undo group. The declaring call is absent on older ;; releases, so it is wrapped rather than tested for. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") ;; Recover the remembered mode and step. (setq flg (= "1" (getenv AttSqueeze:ModeKey)) inc (getenv AttSqueeze:StepKey) ) (setvar 'dimzin 0) (if (not (and inc (< 0.0 (setq inc (distof inc))))) (progn (setq inc 0.1) (setenv AttSqueeze:StepKey "0.1") ) ) ;; Re-prompt until a suitable attribute is picked. (while (progn (setvar 'errno 0) (setq ent (car (nentsel "\nSelect a single-line attribute: "))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil) ( (/= "ATTRIB" (cdr (assoc 0 (setq enx (entget ent))))) (princ "\nThat object is not an attribute.") ) ( (member '(101 . "Embedded Object") enx) (princ "\nMultiline attributes have no width factor - they wrap instead.") ) ) ) ) (if (= 'ename (type ent)) (progn ;; --------------------------------------------------------------- ;; Set up the drag geometry, computed once: ;; ;; old - the current width factor, for cancel and reset ;; fac - the text's width at factor 1, so a measured distance can ;; be turned into a factor. The halving for centred text is ;; because a centred attribute grows in both directions from ;; its base point, so a given cursor distance corresponds to ;; twice the width. ;; bpt - the base point: group 10 for plain left-justified text, ;; group 11 for everything else, since that is where the ;; live position is stored ;; vec - a unit vector along the text direction, from its rotation ;; --------------------------------------------------------------- (setq ent (cons -1 ent) old (cdr (assoc 41 enx)) fac (/ ((lambda ( x ) (- (caadr x) (caar x))) (textbox enx)) (if (= 1 (cdr (assoc 72 enx))) 2 1) old ) bpt (trans (cdr (assoc (if (and (= 0 (cdr (assoc 72 enx))) (= 0 (cdr (assoc 74 enx))) ) 10 11 ) enx ) ) (cdr ent) 1 ) vec (trans (list (cos (cdr (assoc 50 enx))) (sin (cdr (assoc 50 enx))) ) (cdr ent) 1 t ) prompt (lambda ( f ) (if f "\n[TAB] for continuous | [I]ncrement | [R]eset | [C]ancel: " "\n[TAB] for increment | [R]eset | [C]ancel: " ) ) ) (princ (prompt flg)) ;; --------------------------------------------------------------- ;; Drag loop. ;; --------------------------------------------------------------- (while (progn (setq gr1 (grread t 15 0) gr2 (cadr gr1) gr1 (car gr1) ) (cond ;; Mouse moved (5) or clicked (3). ( (or (= 5 gr1) (= 3 gr1)) (redraw) ;; Project the cursor displacement onto the text ;; direction: the dot product gives the distance ;; along the text however the cursor moved. (setq wid (abs (/ (apply '+ (mapcar '* (mapcar '- gr2 bpt) vec)) fac))) ;; In stepped mode, round to the nearest multiple. ;; Adding half a step before truncating is what ;; makes it round rather than always floor. (if flg (setq wid (* inc (fix (/ (+ wid (/ inc 2.0)) inc)))) ) (if (< 0.01 wid 100.0) (progn (entmod (list ent (cons 41 wid))) (AttSqueeze:ShowText gr2 (AttSqueeze:GrText (rtos wid 2 2)) 3 15 -31) ) ;; Out of range: shown in red, and nothing ;; applied - AutoCAD would reject it anyway. (AttSqueeze:ShowText gr2 (AttSqueeze:GrText "Invalid width factor") 1 15 -31) ) (= 5 gr1) ; keep looping on movement, stop on click ) ;; A keypress. ( (= 2 gr1) (cond ;; TAB toggles continuous and stepped. ( (= 9 gr2) (princ (prompt (setq flg (not flg)))) t ) ;; I sets the step - only meaningful in stepped ;; mode. initget 6 rejects zero and negative. ( (and flg (member gr2 '(73 105))) (redraw) (initget 6) (if (setq tmp (getdist (strcat "\nSpecify increment <" (getenv AttSqueeze:StepKey) ">: "))) (setenv AttSqueeze:StepKey (rtos (setq inc tmp) 2 8)) ) (princ (prompt flg)) t ) ;; R resets to the block definition's width. ( (member gr2 '(82 114)) (setq res (AttSqueeze:DefinitionWidth enx)) (entmod (list ent (cond (res) ('(41 . 1.0))))) (princ (strcat "\nWidth reset to " (rtos (cond ((cdr res)) (1.0)) 2 2))) t ) ;; C cancels, restoring the original. ( (member gr2 '(67 99)) (entmod (list ent (cons 41 old))) (setq cancelled t) (princ (strcat "\nCancelled - width restored to " (rtos old 2 2))) nil ) (t t) ) ) ;; Right-click cancels too. ( (= 25 gr1) (entmod (list ent (cons 41 old))) (setq cancelled t) (princ (strcat "\nCancelled - width restored to " (rtos old 2 2))) nil ) (t t) ) ) ) (if (not cancelled) (princ (strcat "\nWidth factor set to " (rtos (cdr (assoc 41 (entget (cdr ent)))) 2 2))) ) ) (princ "\n*Cancelled*") ) (AttSqueeze:Restore) (princ) ) (princ)