;------------------------------------------------------------------------------- ; Program Name: Bevel.lsp [Bevel R1] ; Created By: Terry Miller (Email: terrycadd@yahoo.com) ; (URL: http://web2.airmail.net/terrycad) ; Date Created: 1-20-06 ; Function: Creates Bevel Dimensions ; Note: Bevel.lsp requires the functions inside of GetIcon.lsp, ; Dcl_Tiles.lsp and Text-Box.lsp. The associated files are ; Bevel.lsp and Bevel.dcl. ;------------------------------------------------------------------------------- ; Revision History ; Rev By Date Description ;------------------------------------------------------------------------------- ; 1 TM 1-20-06 Initial version ;------------------------------------------------------------------------------- ; Overview of Main Functions ;------------------------------------------------------------------------------- ; c:BVS - Bevel Settings allows the user to customize various Bevel settings. ; c:BV and c:Bevel - Draws a Bevel. ; BV - Bevel programming function to draw a Bevel. ; Bevel - Calculates bevel based upon radian angle of slope ;------------------------------------------------------------------------------- ; c:BVS - Bevel Settings ;------------------------------------------------------------------------------- (defun c:BVS ()(BevelSettings));Shortcut (defun BevelSettings (/ BevelImage: Chk_Value: Cnt# Dcl_Id% FileName% Fill_Color: Info: Item List@ List001@ List002@ List006@ List007@ List008@ List101@ Other008@ PathFilename$ Return# Save007$ Save008$ Save009$ Text$ Var001$ Var002$ Var003$ Var004$ Var005$ Var006$ Var007$ Var008$ Var009$ Var010$ Var101$ Verify_Info:) (princ "\nCommand: BVS\nBevel Settings\n")(princ) (Bevel_Support) ;----------------------------------------------------------------------------- ; BevelImage: - Bevel Image ;----------------------------------------------------------------------------- (defun BevelImage: (/ C); X = 222, Y = 180 (start_image "Image011") (fill_image 0 0 (dimx_tile "Image011") 3 -15) (fill_image 0 3 (dimx_tile "Image011") (dimy_tile "Image011") -2) (mapcar 'vector_image; Color 7 (list 0 34) (list 24 179) (list 221 187) (list 158 3) (list 7 7) );mapcar (setq C Var101$) (cond ((and (= Var006$ "Unstacked")(= Var010$ "0")) (mapcar 'vector_image; Unstacked, No Inch Mark (list 154 156 159 159 163 160 159 77 78 79 80 76 58 60 63 63 67 64 63 167 169 172 172 176 173 172 45 47 50 50 54 51 50 38 40 44 47 44 43 39 72 163 143 149 149 58 58 89 91 105 104 103 102 102 115 116 117 118 114 127 129 143 142 141 140 140 137 137 136 135 134 133 132 99 99 98 97 96 95 94 56 57 58 59 55 66 66 65 64 63 62 61 69 71 75 79 76 75 76 78 142 144 148 151 148 147 160 161 162 163 159 170 170 169 168 167 166 165 173 175 179 183 180 179 180 182) (list 144 143 151 150 144 143 144 55 53 51 49 49 32 31 39 38 32 31 32 47 46 54 53 47 46 47 129 128 136 135 129 128 129 108 107 107 108 115 108 43 43 37 60 119 139 122 122 50 49 49 50 52 54 55 131 129 127 125 125 126 125 125 126 128 130 131 124 124 126 128 131 133 135 48 48 50 52 55 57 59 113 111 109 107 107 106 106 108 110 113 115 117 108 107 111 112 115 108 107 107 67 66 66 67 74 67 72 70 68 66 66 65 65 67 69 72 74 76 67 66 70 71 74 67 66 66) (list 155 156 163 163 163 162 160 77 78 79 80 80 59 60 67 67 67 66 64 168 169 176 176 176 175 173 46 47 54 54 54 53 51 39 40 46 47 46 43 72 72 163 163 149 182 78 58 90 91 105 105 104 103 106 115 116 117 118 118 128 129 143 143 142 141 144 138 137 136 135 134 133 133 100 99 98 97 96 95 95 56 57 58 59 59 67 66 65 64 63 62 62 70 71 78 79 78 75 78 79 143 144 150 151 150 147 160 161 162 163 163 171 170 169 168 167 166 166 174 175 182 183 182 179 182 183) (list 144 151 151 146 146 143 143 57 54 52 50 49 32 39 39 34 34 31 31 47 54 54 49 49 46 46 129 136 136 131 131 128 128 108 115 107 114 115 114 43 63 60 60 139 139 122 145 50 57 57 49 51 53 55 133 130 128 126 125 126 133 133 125 127 129 131 123 125 127 130 132 134 134 47 49 51 54 56 58 58 115 112 110 108 107 105 107 109 112 114 116 116 108 115 111 114 115 114 107 108 67 74 66 73 74 73 74 71 69 67 66 64 66 68 71 73 75 75 67 74 70 73 74 73 66 67) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Unstacked")(= Var010$ "1")) (mapcar 'vector_image; Unstacked, With Inch Mark (list 151 153 156 156 160 157 156 77 78 79 80 76 55 57 60 60 64 61 60 167 169 172 172 176 173 172 39 41 44 44 48 45 44 36 38 42 45 42 41 39 72 163 143 149 149 58 58 89 91 105 104 103 102 102 111 112 113 114 110 123 125 139 138 137 136 136 133 133 132 131 130 129 128 99 99 98 97 96 95 94 54 55 56 57 53 64 64 63 62 61 60 59 67 69 73 77 74 73 74 76 139 141 145 148 145 144 157 158 159 160 156 167 167 166 165 164 163 162 170 172 176 180 177 176 177 179 70 69 67 66 166 165 163 162 182 181 179 178 54 53 51 50 111 110 108 107 145 144 142 141 83 82 80 79 186 185 183 182) (list 145 144 152 151 145 144 145 55 53 51 49 49 32 31 39 38 32 31 32 47 46 54 53 47 46 47 129 128 136 135 129 128 129 108 107 107 108 115 108 43 43 37 60 119 139 122 122 50 49 49 50 52 54 55 131 129 127 125 125 126 125 125 126 128 130 131 124 124 126 128 131 133 135 48 48 50 52 55 57 59 113 111 109 107 107 106 106 108 110 113 115 117 108 107 111 112 115 108 107 107 67 66 66 67 74 67 72 70 68 66 66 65 65 67 69 72 74 76 67 66 70 71 74 67 66 66 30 32 30 32 143 145 143 145 45 47 45 47 127 129 127 129 48 50 48 50 124 126 124 126 106 108 106 108 65 67 65 67) (list 152 153 160 160 160 159 157 77 78 79 80 80 56 57 64 64 64 63 61 168 169 176 176 176 175 173 40 41 48 48 48 47 45 37 38 44 45 44 41 72 72 163 163 149 182 78 58 90 91 105 105 104 103 106 111 112 113 114 114 124 125 139 139 138 137 140 134 133 132 131 130 129 129 100 99 98 97 96 95 95 54 55 56 57 57 65 64 63 62 61 60 60 68 69 76 77 76 73 76 77 140 141 147 148 147 144 157 158 159 160 160 168 167 166 165 164 163 163 171 172 179 180 179 176 179 180 70 70 67 67 166 166 163 163 182 182 179 179 54 54 51 51 111 111 108 108 145 145 142 142 83 83 80 80 186 186 183 183) (list 145 152 152 147 147 144 144 57 54 52 50 49 32 39 39 34 34 31 31 47 54 54 49 49 46 46 129 136 136 131 131 128 128 108 115 107 114 115 114 43 63 60 60 139 139 122 145 50 57 57 49 51 53 55 133 130 128 126 125 126 133 133 125 127 129 131 123 125 127 130 132 134 134 47 49 51 54 56 58 58 115 112 110 108 107 105 107 109 112 114 116 116 108 115 111 114 115 114 107 108 67 74 66 73 74 73 74 71 69 67 66 64 66 68 71 73 75 75 67 74 70 73 74 73 66 67 31 31 31 31 144 144 144 144 46 46 46 46 128 128 128 128 49 49 49 49 125 125 125 125 107 107 107 107 66 66 66 66) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Diagonal fraction")(= Var009$ "1")(= Var010$ "0")) (mapcar 'vector_image; Diagonal, No Blank, No Inch Mark (list 154 156 159 159 163 160 159 79 80 81 82 78 85 84 91 90 89 89 58 60 63 63 67 64 63 169 171 174 174 178 175 174 43 45 48 48 52 49 48 56 58 62 65 62 61 67 70 69 68 74 73 77 80 78 77 78 79 74 34 147 147 130 131 132 133 129 136 135 142 141 140 140 140 165 56 56 140 142 146 149 146 145 151 154 153 152 158 157 161 164 162 161 162 163 89 88 86 84 140 139 137 135 72 70 69 67 156 154 153 151) (list 147 146 154 153 147 146 147 54 52 50 48 48 46 47 52 53 55 57 29 28 36 35 29 28 29 48 47 55 54 48 47 48 130 129 137 136 130 129 130 106 105 105 106 113 106 103 103 105 107 109 110 112 113 115 110 109 109 40 40 118 142 132 130 128 126 126 124 125 130 131 133 135 63 35 119 119 70 69 69 70 77 70 67 67 69 71 73 74 76 77 79 74 73 73 49 51 54 57 127 129 132 135 106 109 111 114 70 73 75 78) (list 155 156 163 163 163 162 160 79 80 81 82 82 85 85 91 90 89 92 59 60 67 67 67 66 64 170 171 178 178 178 177 175 44 45 52 52 52 51 49 57 58 64 65 64 61 70 70 69 68 74 74 79 80 79 77 79 80 74 74 147 187 130 131 132 133 133 136 136 142 141 140 143 165 165 56 81 141 142 148 149 148 145 154 154 153 152 158 158 163 164 163 161 163 164 91 89 88 86 142 140 139 137 74 72 70 69 158 156 154 153) (list 147 154 154 149 149 146 146 56 53 51 49 48 52 46 58 54 57 57 29 36 36 31 31 28 28 48 55 55 50 50 47 47 130 137 137 132 132 129 129 106 113 105 112 113 112 103 104 106 109 115 109 112 114 115 114 109 110 64 40 142 142 134 131 129 127 126 130 124 136 132 135 135 63 63 148 119 70 77 69 76 77 76 67 68 70 73 79 73 76 78 79 78 73 74 47 50 52 55 125 128 130 133 104 107 110 112 68 71 74 76) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Diagonal fraction")(= Var009$ "1")(= Var010$ "1")) (mapcar 'vector_image; Diagonal, No Blank, With Inch Mark (list 151 153 156 156 160 157 156 166 165 163 162 79 80 81 82 78 85 84 91 90 89 89 96 95 93 92 55 57 60 60 64 61 60 70 69 67 66 169 171 174 174 178 175 174 184 183 181 180 37 39 42 42 46 43 42 52 51 49 48 54 56 60 63 60 59 82 81 79 78 65 68 67 66 72 71 75 78 76 75 76 77 74 34 147 147 126 127 128 129 125 132 131 138 137 136 136 143 142 140 139 140 165 56 56 139 141 145 148 145 144 167 166 164 163 150 153 152 151 157 156 160 163 161 160 161 162 89 88 86 84 136 135 133 131 70 68 67 65 155 153 152 150) (list 148 147 155 154 148 147 148 146 148 146 148 54 52 50 48 48 46 47 52 53 55 57 47 49 47 49 29 28 36 35 29 28 29 27 29 27 29 48 47 55 54 48 47 48 46 48 46 48 130 129 137 136 130 129 130 128 130 128 130 106 105 105 106 113 106 104 106 104 106 103 103 105 107 109 110 112 113 115 110 109 109 40 40 118 142 132 130 128 126 126 124 125 130 131 133 135 125 127 125 127 63 35 119 119 70 69 69 70 77 70 68 70 68 70 67 67 69 71 73 74 76 77 79 74 73 73 49 51 54 57 127 129 132 135 106 109 111 114 70 73 75 78) (list 152 153 160 160 160 159 157 166 166 163 163 79 80 81 82 82 85 85 91 90 89 92 96 96 93 93 56 57 64 64 64 63 61 70 70 67 67 170 171 178 178 178 177 175 184 184 181 181 38 39 46 46 46 45 43 52 52 49 49 55 56 62 63 62 59 82 82 79 79 68 68 67 66 72 72 77 78 77 75 77 78 74 74 147 187 126 127 128 129 129 132 132 138 137 136 139 143 143 140 140 165 165 56 81 140 141 147 148 147 144 167 167 164 164 153 153 152 151 157 157 162 163 162 160 162 163 91 89 88 86 138 136 135 133 72 70 68 67 157 155 153 152) (list 148 155 155 150 150 147 147 147 147 147 147 56 53 51 49 48 52 46 58 54 57 57 48 48 48 48 29 36 36 31 31 28 28 28 28 28 28 48 55 55 50 50 47 47 47 47 47 47 130 137 137 132 132 129 129 129 129 129 129 106 113 105 112 113 112 105 105 105 105 103 104 106 109 115 109 112 114 115 114 109 110 64 40 142 142 134 131 129 127 126 130 124 136 132 135 135 126 126 126 126 63 63 148 119 70 77 69 76 77 76 69 69 69 69 67 68 70 73 79 73 76 78 79 78 73 74 47 50 52 55 125 128 130 133 104 107 110 112 68 71 74 76) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Diagonal fraction")(= Var009$ "0")(= Var010$ "0")) (mapcar 'vector_image; Diagonal, With Blank, No Inch Mark (list 154 156 157 159 68 70 71 73 132 134 136 137 91 93 95 96 166 165 164 165 167 164 161 160 155 156 157 154 144 145 148 145 141 139 52 52 138 169 144 144 26 77 137 137 138 139 133 132 122 126 125 124 123 80 79 78 79 81 78 75 74 69 70 71 68 58 59 62 59 55 53 44 45 48 44 44 41 39 178 179 182 178 178 175 173 62 63 66 62 62 59 57 96 96 97 98 92 91 81 85 84 83 82 159 160 163 159 159 156 154) (list 81 78 76 73 111 108 106 103 136 133 130 128 56 53 50 48 76 76 77 82 80 79 76 77 74 72 70 70 73 80 73 72 72 73 116 116 66 30 116 147 35 35 136 134 132 131 125 126 127 127 129 131 133 106 106 107 112 110 109 106 107 104 102 100 100 103 110 103 102 102 103 130 129 130 136 137 129 130 48 47 48 54 55 47 48 24 23 24 30 31 23 24 56 54 52 51 45 46 47 47 49 51 53 152 151 152 158 159 151 152) (list 156 157 159 161 70 71 73 75 134 136 137 139 93 95 96 98 167 166 164 166 167 166 161 161 155 156 157 157 144 147 148 147 141 140 52 83 169 169 144 195 77 77 140 137 138 139 133 133 126 126 125 124 123 81 80 78 80 81 80 75 75 69 70 71 71 58 61 62 61 55 54 45 47 48 48 48 41 40 179 181 182 182 182 175 174 63 65 66 66 66 59 58 99 96 97 98 92 92 85 85 84 83 82 160 162 163 163 163 156 155) (list 79 77 74 71 109 107 104 101 134 131 129 126 54 51 49 46 77 76 81 82 81 79 82 76 76 73 71 70 79 80 79 72 80 73 152 116 66 66 147 147 35 66 136 136 133 137 131 125 127 128 130 132 135 107 106 111 112 111 109 112 106 106 103 101 100 109 110 109 102 110 103 129 129 132 132 137 137 130 47 47 50 50 55 55 48 23 23 26 26 31 31 24 56 56 53 57 51 45 47 48 50 52 55 151 151 154 154 159 159 152) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Diagonal fraction")(= Var009$ "0")(= Var010$ "1")) (mapcar 'vector_image; Diagonal, With Blank, With Inch Mark (list 151 153 156 156 160 157 156 166 165 163 162 82 83 84 85 81 92 91 98 97 96 96 103 102 100 99 55 57 60 60 64 61 60 70 69 67 66 173 175 178 178 182 179 178 188 187 185 184 33 35 38 38 42 39 38 48 47 45 44 51 53 57 60 57 56 83 82 80 79 66 69 68 67 73 72 76 79 77 76 77 78 119 120 121 122 118 129 128 135 134 133 133 140 139 137 136 77 26 144 144 169 138 52 52 138 140 144 147 144 143 170 169 167 166 153 156 155 154 160 159 163 166 164 163 164 165 96 95 93 91 133 132 130 128 71 69 68 66 158 156 155 153) (list 153 152 160 159 153 152 153 151 153 151 153 53 51 49 47 47 45 46 51 52 54 56 46 48 46 48 24 23 31 30 24 23 24 22 24 22 24 48 47 55 54 48 47 48 46 48 46 48 130 129 137 136 130 129 130 128 130 128 130 103 102 102 103 110 103 101 103 101 103 100 100 102 104 106 107 109 110 112 107 106 106 133 131 129 127 127 125 126 131 132 134 136 126 128 126 128 35 35 147 116 30 66 116 116 73 72 72 73 80 73 71 73 71 73 70 70 72 74 76 77 79 80 82 77 76 76 48 50 53 56 128 130 133 136 103 106 108 111 73 76 78 81) (list 152 153 160 160 160 159 157 166 166 163 163 82 83 84 85 85 92 92 98 97 96 99 103 103 100 100 56 57 64 64 64 63 61 70 70 67 67 174 175 182 182 182 181 179 188 188 185 185 34 35 42 42 42 41 39 48 48 45 45 52 53 59 60 59 56 83 83 80 80 69 69 68 67 73 73 78 79 78 76 78 79 119 120 121 122 122 129 129 135 134 133 136 140 140 137 137 77 77 195 144 169 169 83 52 139 140 146 147 146 143 170 170 167 167 156 156 155 154 160 160 165 166 165 163 165 166 98 96 95 93 135 133 132 130 73 71 69 68 160 158 156 155) (list 153 160 160 155 155 152 152 152 152 152 152 55 52 50 48 47 51 45 57 53 56 56 47 47 47 47 24 31 31 26 26 23 23 23 23 23 23 48 55 55 50 50 47 47 47 47 47 47 130 137 137 132 132 129 129 129 129 129 129 103 110 102 109 110 109 102 102 102 102 100 101 103 106 112 106 109 111 112 111 106 107 135 132 130 128 127 131 125 137 133 136 136 127 127 127 127 66 35 147 147 66 66 116 152 73 80 72 79 80 79 72 72 72 72 70 71 73 76 82 76 79 81 82 81 76 77 46 49 51 54 126 129 131 134 101 104 107 109 71 74 77 79) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Horizontal fraction")(= Var009$ "1")(= Var010$ "0")) (mapcar 'vector_image; Horizontal, No Blank, No Inch Mark (list 144 145 82 83 70 71 154 155 150 150 154 156 159 159 163 160 159 138 139 140 141 137 145 144 143 143 71 44 76 77 78 79 75 83 82 81 81 58 60 63 63 67 64 63 164 166 169 169 173 170 169 48 50 53 53 57 54 53 160 145 61 61 59 61 65 68 65 64 72 75 74 73 74 77 75 74 75 76 143 145 149 152 149 148 156 159 158 157 158 161 159 158 159 160 154 70 81 143) (list 121 120 47 46 115 114 73 72 136 120 141 140 148 147 141 140 141 130 128 126 124 124 130 131 133 135 46 46 56 54 52 50 50 56 57 59 61 35 34 42 41 35 34 35 48 47 55 54 48 47 48 130 129 137 136 130 129 130 40 58 124 124 109 108 108 109 116 109 104 104 106 108 117 118 120 115 114 114 67 66 66 67 74 67 62 62 64 66 75 76 78 73 72 72 70 112 54 128) (list 145 145 83 83 71 71 155 155 177 150 155 156 163 163 163 162 160 138 139 140 141 141 145 144 143 146 71 71 76 77 78 79 79 83 82 81 84 59 60 67 67 67 66 64 165 166 173 173 173 172 170 49 50 57 57 57 56 54 160 160 61 76 60 61 67 68 67 64 75 75 74 73 76 77 76 74 76 77 144 145 151 152 151 148 159 159 158 157 160 161 160 158 160 161 161 77 84 146) (list 120 126 46 52 114 120 72 78 136 136 141 148 148 143 143 140 140 132 129 127 125 124 136 132 135 135 62 46 58 55 53 51 50 62 58 61 61 35 42 42 37 37 34 34 48 55 55 50 50 47 47 130 137 137 132 132 129 129 58 58 142 124 109 116 108 115 116 115 104 105 107 110 117 119 120 119 114 115 67 74 66 73 74 73 62 63 65 68 75 77 78 77 72 73 70 112 54 128) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Horizontal fraction")(= Var009$ "1")(= Var010$ "1")) (mapcar 'vector_image; Horizontal, No Blank, With Inch Mark (list 152 153 160 161 163 164 68 69 76 77 79 80 53 54 56 57 175 176 178 179 66 67 69 70 85 86 88 89 82 83 142 143 145 146 139 140 162 163 165 166 150 150 151 153 156 156 160 157 156 133 134 135 136 132 140 139 138 138 71 44 76 77 78 79 75 83 82 81 81 55 57 60 60 64 61 60 164 166 169 169 173 170 169 42 44 47 47 51 48 47 160 145 61 61 57 59 63 66 63 62 70 73 72 71 72 75 73 72 73 74 141 143 147 150 147 146 154 157 156 155 156 159 157 156 157 158 152 68 81 138) (list 73 72 67 65 67 65 115 114 109 107 109 107 130 128 130 128 48 46 48 46 35 33 35 33 51 49 51 49 47 46 125 123 125 123 121 120 142 140 142 140 136 120 142 141 149 148 142 141 142 130 128 126 124 124 130 131 133 135 46 46 56 54 52 50 50 56 57 59 61 35 34 42 41 35 34 35 48 47 55 54 48 47 48 130 129 137 136 130 129 130 40 58 124 124 109 108 108 109 116 109 104 104 106 108 117 118 120 115 114 114 67 66 66 67 74 67 62 62 64 66 75 76 78 73 72 72 70 112 54 128) (list 153 153 161 161 164 164 69 69 77 77 80 80 54 54 57 57 176 176 179 179 67 67 70 70 86 86 89 89 83 83 143 143 146 146 140 140 163 163 166 166 177 150 152 153 160 160 160 159 157 133 134 135 136 136 140 139 138 141 71 71 76 77 78 79 79 83 82 81 84 56 57 64 64 64 63 61 165 166 173 173 173 172 170 43 44 51 51 51 50 48 160 160 61 76 58 59 65 66 65 62 73 73 72 71 74 75 74 72 74 75 142 143 149 150 149 146 157 157 156 155 158 159 158 156 158 159 159 75 84 141) (list 72 78 66 66 66 66 114 120 108 108 108 108 129 129 129 129 47 47 47 47 34 34 34 34 50 50 50 50 46 52 124 124 124 124 120 126 141 141 141 141 136 136 142 149 149 144 144 141 141 132 129 127 125 124 136 132 135 135 62 46 58 55 53 51 50 62 58 61 61 35 42 42 37 37 34 34 48 55 55 50 50 47 47 130 137 137 132 132 129 129 58 58 142 124 109 116 108 115 116 115 104 105 107 110 117 119 120 119 114 115 67 74 66 73 74 73 62 63 65 68 75 77 78 77 72 73 70 112 54 128) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Horizontal fraction")(= Var009$ "0")(= Var010$ "0")) (mapcar 'vector_image; Horizontal, With Blank, No Inch Mark (list 72 73 156 157 88 89 142 143 154 156 159 159 163 160 159 132 133 134 135 131 143 142 141 141 78 79 80 81 77 89 88 87 87 58 60 63 63 67 64 63 168 170 173 173 177 174 173 44 46 49 49 53 50 49 141 143 147 150 147 146 158 161 160 159 160 163 161 160 161 162 148 148 73 38 142 164 57 57 57 59 63 66 63 62 74 77 76 75 76 79 77 76 77 78 72 156 87 141) (list 112 111 76 75 46 45 122 121 145 144 152 151 145 144 145 131 129 127 125 125 131 132 134 136 55 53 51 49 49 55 56 58 60 31 30 38 37 31 30 31 48 47 55 54 48 47 48 130 129 137 136 130 129 130 70 69 69 70 77 70 65 65 67 69 78 79 81 76 75 75 119 140 42 42 61 36 121 121 106 105 105 106 113 106 101 101 103 105 114 115 117 112 111 111 109 73 53 129) (list 73 73 157 157 89 89 143 143 155 156 163 163 163 162 160 132 133 134 135 135 143 142 141 144 78 79 80 81 81 89 88 87 90 59 60 67 67 67 66 64 169 170 177 177 177 176 174 45 46 53 53 53 52 50 142 143 149 150 149 146 161 161 160 159 162 163 162 160 162 163 148 183 73 73 164 164 79 57 58 59 65 66 65 62 77 77 76 75 78 79 78 76 78 79 79 163 90 144) (list 111 117 75 81 45 51 121 127 145 152 152 147 147 144 144 133 130 128 126 125 137 133 136 136 57 54 52 50 49 61 57 60 60 31 38 38 33 33 30 30 48 55 55 50 50 47 47 130 137 137 132 132 129 129 70 77 69 76 77 76 65 66 68 71 78 80 81 80 75 76 140 140 63 42 61 61 121 146 106 113 105 112 113 112 101 102 104 107 114 116 117 116 111 112 109 73 53 129) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case ((and (= Var006$ "Horizontal fraction")(= Var009$ "0")(= Var010$ "1")) (mapcar 'vector_image; Horizontal, With Blank, With Inch Mark (list 70 71 78 79 81 82 154 155 162 163 165 166 49 50 52 53 179 180 182 183 66 67 69 70 91 92 94 95 88 89 140 141 143 144 137 138 162 163 165 166 151 153 156 156 160 157 156 127 128 129 130 126 138 137 136 136 78 79 80 81 77 89 88 87 87 55 57 60 60 64 61 60 168 170 173 173 177 174 173 38 40 43 43 47 44 43 139 141 145 148 145 144 156 159 158 157 158 161 159 158 159 160 148 148 73 38 142 164 57 57 55 57 61 64 61 60 72 75 74 73 74 77 75 74 75 76 70 154 87 136) (list 112 111 106 104 106 104 76 75 70 68 70 68 130 128 130 128 48 46 48 46 31 29 31 29 50 48 50 48 46 45 126 124 126 124 122 121 146 144 146 144 146 145 153 152 146 145 146 131 129 127 125 125 131 132 134 136 55 53 51 49 49 55 56 58 60 31 30 38 37 31 30 31 48 47 55 54 48 47 48 130 129 137 136 130 129 130 70 69 69 70 77 70 65 65 67 69 78 79 81 76 75 75 119 140 42 42 61 36 121 121 106 105 105 106 113 106 101 101 103 105 114 115 117 112 111 111 109 73 53 129) (list 71 71 79 79 82 82 155 155 163 163 166 166 50 50 53 53 180 180 183 183 67 67 70 70 92 92 95 95 89 89 141 141 144 144 138 138 163 163 166 166 152 153 160 160 160 159 157 127 128 129 130 130 138 137 136 139 78 79 80 81 81 89 88 87 90 56 57 64 64 64 63 61 169 170 177 177 177 176 174 39 40 47 47 47 46 44 140 141 147 148 147 144 159 159 158 157 160 161 160 158 160 161 148 183 73 73 164 164 79 57 56 57 63 64 63 60 75 75 74 73 76 77 76 74 76 77 77 161 90 139) (list 111 117 105 105 105 105 75 81 69 69 69 69 129 129 129 129 47 47 47 47 30 30 30 30 49 49 49 49 45 51 125 125 125 125 121 127 145 145 145 145 146 153 153 148 148 145 145 133 130 128 126 125 137 133 136 136 57 54 52 50 49 61 57 60 60 31 38 38 33 33 30 30 48 55 55 50 50 47 47 130 137 137 132 132 129 129 70 77 69 76 77 76 65 66 68 71 78 80 81 80 75 76 140 140 63 42 61 61 121 146 106 113 105 112 113 112 101 102 104 107 114 116 117 116 111 112 109 73 53 129) (list C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C) );mapcar );case );cond (end_image) );defun BevelImage: ;----------------------------------------------------------------------------- ; Chk_Value: - Check dialog values ;----------------------------------------------------------------------------- (defun Chk_Value: ($key $value / KeyName$ NumKey$ SaveVar$ TitleBar$ VarNum$) (setq NumKey$ (substr $key (- (strlen $key) 2)) ; Last 3 digits VarNum$ (strcat "Var" NumKey$ "$") ; Variable name SaveVar$ (eval (read VarNum$)) ; Previous value KeyName$ (substr $key 1 (- (strlen $key) 3)); Key name );setq (cond ((= NumKey$ "008")(setq TitleBar$ "Other Fraction height scale")) );cond (Set_Value $key $value) ;--------------------------------------------------------------------------- ; Exceptions to Set_Value ;--------------------------------------------------------------------------- (if (and (= NumKey$ "001")(/= Var001$ SaveVar$)) (progn (setq Var101$ (FindInList Var001$ List001@ List101@)) (Fill_Color: "Image101" Var101$) );progn );if (if (and (= NumKey$ "003")(< (stor Var003$) 0)) (progn (setq Var003$ (substr Var003$ 2)) (set_tile "EditArchOrReal003" (ArchOrReal Var003$)) );progn );if (if (and (= NumKey$ "004")(< (stor Var004$) 0)) (progn (setq Var004$ (substr Var004$ 2)) (set_tile "EditArchOrReal004" (ArchOrReal Var004$)) );progn );if (if (and (= NumKey$ "005")(< (stor Var005$) 0)) (progn (setq Var005$ (substr Var005$ 2)) (set_tile "EditArchOrReal005" (ArchOrReal Var005$)) );progn );if (if (and (= NumKey$ "003")(= (stor Var003$) 0)) (progn (GetOk "Invalid Value" "The Text height must\nbe greater than zero." "exclam") (setq Var003$ SaveVar$) (set_tile "EditArchOrReal003" (ArchOrReal Var003$)) );progn );if (if (and (= NumKey$ "008")(or (< (atoi Var008$) 25)(> (atoi Var008$) 125))) (progn (GetOk "Invalid Value" "The valid range for Fractional height scale\nis an integer between 25 and 125." "exclam") (setq Var008$ SaveVar$) (if (member Var008$ Other008@) (setq List008@ Other008@) (setq List008@ (Insert_nth (1- (length Other008@)) Var008$ Other008@)) );if (set_tile_list "ListInt008" List008@ Var008$) );progn );if (if (and (= NumKey$ "006")(= Var006$ "Unstacked")(/= Var006$ SaveVar$)) (progn (setq Save007$ Var007$ Save008$ Var008$ Save009$ Var009$ Var007$ "Center" Var008$ "100" Var009$ "0" );setq (set_tile_list "List007" List007@ Var007$) (set_tile_list "ListInt008" List008@ Var008$) (set_tile "Toggle009" Var009$) (mode_tile "List007" 1) (mode_tile "ListInt008" 1) (mode_tile "Toggle009" 1) );progn );if (if (and (= NumKey$ "006")(= SaveVar$ "Unstacked")(/= Var006$ SaveVar$)) (progn (setq Var007$ Save007$ Var008$ Save008$ Var009$ Save009$ );setq (set_tile_list "List007" List007@ Var007$) (set_tile_list "ListInt008" List008@ Var008$) (set_tile "Toggle009" Var009$) (mode_tile "List007" 0) (mode_tile "ListInt008" 0) (mode_tile "Toggle009" 0) );progn );if (if (or (and (= NumKey$ "001")(/= Var001$ SaveVar$))(= NumKey$ "006")(= NumKey$ "009")(= NumKey$ "010")) (BevelImage:) );if );defun Chk_Value: ;----------------------------------------------------------------------------- ; Fill_Color: - Fills in layer color image ;----------------------------------------------------------------------------- (defun Fill_Color: (KeyName$ Color#) (start_image KeyName$) (fill_image 0 0 (dimx_tile KeyName$) (dimy_tile KeyName$) Color#) (fill_image 0 0 (dimx_tile KeyName$) 6 -15) (vector_image 0 6 0 (1- (dimy_tile KeyName$)) 250) (vector_image 0 (1- (dimy_tile KeyName$)) (1- (dimx_tile KeyName$)) (1- (dimy_tile KeyName$)) 250) (vector_image (1- (dimx_tile KeyName$)) (1- (dimy_tile KeyName$)) (1- (dimx_tile KeyName$)) 6 250) (vector_image (1- (dimx_tile KeyName$)) 6 0 6 250) (end_image) );defun Fill_Color: ;----------------------------------------------------------------------------- ; Info: - Additional Information ;----------------------------------------------------------------------------- (defun Info: () (GetOK "Bevel Information" (strcat "The Bevel Settings for Text height,\n" "Dimension gap and Bevel offset gap\n" "are based upon Dimscale 1. The valid\n" "range for Fractional height scale is\n" "an integer between 25 and 125.") "") );defun Info: ;----------------------------------------------------------------------------- ; Verify_Info: - Verifies that the required information is correct ;----------------------------------------------------------------------------- (defun Verify_Info: () (if (or (<= (stor Var003$) 0) (or (< (atoi Var008$) 25)(> (atoi Var008$) 125))) (GetOk "Invalid Value" (strcat "The Text height must be greater than zero, and the\n" "Fractional height scale must be between 25 and 125.") "exclam") (done_dialog 1) );if );defun Verify_Info: ;----------------------------------------------------------------------------- ; Set Default Variables and List Values ;----------------------------------------------------------------------------- (setq List001@ (GetLayers) List101@ (GetLayerColors) List006@ (list "Unstacked" "Diagonal fraction" "Horizontal fraction") List007@ (list "Top" "Center" "Bottom") List008@ (list "100" "90" "80" "75" "70" "66" "50" "" "Other");25 to 125 );setq (setq List@ (GetFonts)) (setq Cnt# 0) (foreach Item (GetStyles) (setq List002@ (append List002@ (list (strcat Item " - " (nth Cnt# List@))))) (setq Cnt# (1+ Cnt#)) );foreach (if (not *Bevel@) (BevelData)) (setq Var001$ (nth 1 *Bevel@) Var002$ (nth 2 *Bevel@) Var003$ (nth 3 *Bevel@) Var004$ (nth 4 *Bevel@) Var005$ (nth 5 *Bevel@) Var006$ (nth 6 *Bevel@) Var007$ (nth 7 *Bevel@) Var008$ (nth 8 *Bevel@) Var009$ (nth 9 *Bevel@) Var010$ (nth 10 *Bevel@) );setq (setq Var009$ (if (= Var009$ "Yes") "1" "0")) (setq Var010$ (if (= Var010$ "Yes") "1" "0")) (if (= Var006$ "Unstacked") (setq Var007$ "Center" Var008$ "100" Var009$ "0" );setq );if (setq Save007$ Var007$ Save008$ Var008$ Save009$ Var009$ );setq (if (not (member Var001$ List001@)) (setq Var001$ (nth 0 List001@)) );if (setq Var101$ (FindInList Var001$ List001@ List101@)) (if (not (member Var002$ List002@)) (setq Var002$ (FindInList Var002$ (GetStyles) List002@)) );if (if (not (member Var002$ List002@)) (setq Var002$ (nth 0 List002@)) );if (setq Other008@ List008@) (if (not (member Var008$ List008@)) (setq List008@ (Insert_nth (1- (length List008@)) Var008$ List008@)) );if ;----------------------------------------------------------------------------- ; Load Dialog ;----------------------------------------------------------------------------- (setq Dcl_Id% (load_dialog "Bevel.dcl")) (new_dialog "Bevel_Settings" Dcl_Id%) ;----------------------------------------------------------------------------- ; Set Dialog Initial Settings ;----------------------------------------------------------------------------- (set_tile "Title" " Bevel Settings") (set_tile "Text001" "Layer for Bevel") (set_tile "Text002" "Text style & font") (set_tile "Text003" "Text height") (set_tile "Text004" "Dimension gap") (set_tile "Text005" "Bevel offset gap") (set_tile "Text006" "Fraction style") (set_tile "Text007" "Fraction position") (set_tile "Text008" "Fraction height scale") (set_tile "Text009" "Remove leading blank") (set_tile "Text010" "Add inch mark") (set_tile_list "List001" List001@ Var001$) (Fill_Color: "Image101" Var101$) (set_tile_list "List002" List002@ Var002$) (set_tile "EditArchOrReal003" (ArchOrReal Var003$)) (set_tile "EditArchOrReal004" (ArchOrReal Var004$)) (set_tile "EditArchOrReal005" (ArchOrReal Var005$)) (set_tile_list "List006" List006@ Var006$) (set_tile_list "List007" List007@ Var007$) (set_tile_list "ListInt008" List008@ Var008$) (set_tile "Toggle009" Var009$) (set_tile "Toggle010" Var010$) (if (= Var006$ "Unstacked") (progn (mode_tile "List007" 1) (mode_tile "ListInt008" 1) (mode_tile "Toggle009" 1) );progn );if (BevelImage:) ;----------------------------------------------------------------------------- ; Dialog Actions ;----------------------------------------------------------------------------- (action_tile "List001" "(Chk_Value: $key $value)") (action_tile "List002" "(Chk_Value: $key $value)") (action_tile "EditArchOrReal003" "(Chk_Value: $key $value)") (action_tile "EditArchOrReal004" "(Chk_Value: $key $value)") (action_tile "EditArchOrReal005" "(Chk_Value: $key $value)") (action_tile "List006" "(Chk_Value: $key $value)") (action_tile "List007" "(Chk_Value: $key $value)") (action_tile "ListInt008" "(Chk_Value: $key $value)") (action_tile "Toggle009" "(Chk_Value: $key $value)") (action_tile "Toggle010" "(Chk_Value: $key $value)") (action_tile "Info" "(Info:)") (action_tile "accept" "(Verify_Info:)") (setq Return# (start_dialog)) (unload_dialog Dcl_Id%) (if (= Return# 0) (exit)) (setq Var009$ (if (= Var009$ "1") "Yes" "No")) (setq Var010$ (if (= Var010$ "1") "Yes" "No")) (setq *Bevel@ (list nil Var001$ Var002$ Var003$ Var004$ Var005$ Var006$ Var007$ Var008$ Var009$ Var010$) );setq (setq List@ (MtextLengths)) (setq *Bevel@ (append *Bevel@ (list (rtos (nth 0 List@) 2 4)(rtos (nth 1 List@) 2 4)(rtos (nth 2 List@) 2 4)))) (setq PathFilename$ "C:\\Temp\\Bevel.dat") (setq FileName% (open PathFilename$ "w")) (foreach Text$ (Delete_nth 0 *Bevel@) (write-line Text$ FileName%) );foreacg (close FileName%) (princ "\nCommand: BVS\nBevel Settings\n") (princ) );defun BevelSettings ;------------------------------------------------------------------------------- ; BevelData - Constructs a default global variable *Bevel@ or reads in the ; settings created by BevelSettings to construct the global variable *Bevel@. ;------------------------------------------------------------------------------- (defun BevelData (/ FileName% PathFilename$ Text$) (if (setq PathFilename$ (findfile "C:\\Temp\\Bevel.dat")) (progn (setq *Bevel@ (list nil)) (setq FileName% (open PathFilename$ "r")) (while (setq Text$ (read-line FileName%)) (setq *Bevel@ (append *Bevel@ (list Text$))) );while (close FileName%) );progn (progn (setq *Bevel@ (list nil (getvar "CLAYER") (Capitals (getvar "TEXTSTYLE")) (rtosr (getvar "DIMTXT")) (rtosr (getvar "DIMGAP")) (rtosr (getvar "DIMEXO")) "Horizontal fraction" "Center" "75" "Yes" "Yes") );setq (setq List@ (MtextLengths)) (setq *Bevel@ (append *Bevel@ (list (rtos (nth 0 List@) 2 4)(rtos (nth 1 List@) 2 4)(rtos (nth 2 List@) 2 4)))) );progn );if (princ) );defun BevelData ;------------------------------------------------------------------------------- ; c:BV and c:Bevel - Draws a Bevel ;------------------------------------------------------------------------------- (defun c:BV ()(c:Bevel));Shortcut (defun c:Bevel (/ Ang1-2~ AngSide~ B1 B2 B3 B1-2 B2-3 Bevel$ BevelAng~ BevelGap~ DimGap~ Dist~ Ent1^ Ent2^ Ent3^ EntList@ EntName^ EntPick@ EntType$ FracScale GroupName$ Height~ HorizLeg~ InchMark Ins Layer$ List@ NoBlank Other$ Position$ Pt Pt1 Pt2 Pt3 Pt4 Side$ Style$ TextSize~ TextStyle$ TextStyleHeight~ Twelve$ VertiLeg~ Width~ X1-2 X2-3 Y1-2 Y2-3) (SaveVars (list "CLAYER" "CMDECHO" "OSMODE" "TEXTSIZE" "TEXTSTYLE")) (setvar "CMDECHO" 0) (if (not *Bevel@) (BevelData)) (setq Layer$ (nth 1 *Bevel@) TextStyle$ (nth 0 (WordList (nth 2 *Bevel@))) TextSize~ (* (atof (nth 3 *Bevel@))(getvar "DIMSCALE")) DimGap~ (* (atof (nth 4 *Bevel@)) (getvar "DIMSCALE")) BevelGap~ (* (atof (nth 5 *Bevel@))(getvar "DIMSCALE")) Style$ (nth 0 (WordList (nth 6 *Bevel@))) Position$ (nth 7 *Bevel@) FracScale (atoi (nth 8 *Bevel@)) NoBlank (if (= (nth 9 *Bevel@) "Yes") t nil) InchMark (if (= (nth 10 *Bevel@) "Yes") t nil) Height~ (* (atof (nth 11 *Bevel@)) (getvar "DIMSCALE")); 10 15/16"' Width~ (* (atof (nth 12 *Bevel@)) (getvar "DIMSCALE")); 10 15/16"' HorizLeg~ (* (atof (nth 13 *Bevel@)) (getvar "DIMSCALE")); 1 15/16" VertiLeg~ Height~ );setq (if (> HorizLeg~ VertiLeg~) (setq VertiLeg~ HorizLeg~)) (if (> VertiLeg~ HorizLeg~) (setq HorizLeg~ VertiLeg~)) (if (= Style$ "Unstacked") (setq HorizLeg~ (/ HorizLeg~ 2.0) VertiLeg~ (/ VertiLeg~ 2.0) );setq );if (setvar "OSMODE" 512) (princ "\nCommand: BV\nSelect a line for Bevel Angle: ") (if (setq EntPick@ (entsel)) (progn (setvar "OSMODE" 0) (setq EntName^ (car EntPick@) Point@ (cadr EntPick@) EntList@ (entget EntName^) EntType$ (cdr (assoc 0 EntList@)) );setq (if (or (= EntType$ "LINE")(= EntType$ "LWPOLYLINE")(= EntType$ "DIMENSION")) (progn (if (= EntType$ "LINE") (setq Pt1 (cdr (assoc 10 EntList@)) Pt2 (cdr (assoc 11 EntList@)) );setq (setq Pt1 (osnap Point@ "END") Pt2 (osnap Point@ "MID") Pt2 (polar Pt2 (angle Pt1 Pt2) (distance Pt1 Pt2)) );setq );if (setq Ang1-2~ (angle Pt1 Pt2)) (if (> Ang1-2~ pi) (progn (setq Ang1-2~ (- Ang1-2~ pi)) (setq Pt Pt1 Pt1 Pt2 Pt2 Pt) );progn );while (setq BevelAng~ (Bevel Ang1-2~)) (if (= Style$ "Unstacked") (if (= BevelAng~ 12) (if InchMark (setq Bevel$ "12\"") (setq Bevel$ "12") );if (if InchMark (setq Bevel$ (Arch BevelAng~)) (setq Bevel$ (substr (Arch BevelAng~) 1 (1- (strlen (Arch BevelAng~))))) );if );if (if (= BevelAng~ 12) (if InchMark (setq Bevel$ "12\"") (setq Bevel$ "12") );if (setq Bevel$ (Stacked BevelAng~ Style$ Position$ FracScale NoBlank InchMark)) );if );if (princ "\nPick the location for Bevel: ") (if (setq Pt3 (getpoint)) (progn (setq Pt4 (polar Pt3 (+ Ang1-2~ (* pi 0.5)) 1)) (setq Ins (inters Pt1 Pt2 Pt3 Pt4 nil)) (setq AngSide~ (angle Ins Pt3)) (setq Pt3 (polar Ins (angle Ins Pt3) 0.000001)) (if (> Ang1-2~ (angle Pt1 Pt3)) (setq Side$ "Right") (setq Side$ "Left") );if (cond ((and (< Ang1-2~ (dtr 45))(= Side$ "Right")) (setq Dist~ (* VertiLeg~ (cos Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 90) VertiLeg~)) (setq B2-3 (polar B2 (dtr 90) (/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 0 DimGap~)) (setq Pt (polar B2 pi 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 pi (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 270) DimGap~)) (setq Twelve$ "TC") (setq X1-2 (polar B1-2 pi (/ Width~ 2.0)) Y1-2 (polar X1-2 (dtr 270) Height~) Y1-2 (polar Y1-2 0 Width~) );setq (setq Other$ "ML") (setq X2-3 (polar B2-3 (dtr 90) (/ Height~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ (dtr 45))(= Side$ "Left")) (setq Dist~ (* VertiLeg~ (cos Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 270) VertiLeg~)) (setq B2-3 (polar B2 (dtr 270)(/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 pi DimGap~)) (setq Pt (polar B2 0 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 0 (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 90) DimGap~)) (setq Twelve$ "BC") (setq X1-2 (polar B1-2 0 (/ Width~ 2.0)) Y1-2 (polar X1-2 (dtr 90) Height~) Y1-2 (polar Y1-2 pi Width~) );setq (setq Other$ "MR") (setq X2-3 (polar B2-3 (dtr 270) (/ Height~ 2.0)) Y2-3 (polar X2-3 pi Width~) Y2-3 (polar Y2-3 (dtr 90) Height~) );setq );case ((and (< Ang1-2~ (dtr 90))(= Side$ "Right")) (setq Dist~ (* HorizLeg~ (sin Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 pi HorizLeg~)) (setq B2-3 (polar B2 pi (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 270) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 270) DimGap~)) );if (setq Pt (polar B2 (dtr 90) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 90) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 0 DimGap~)) (setq Twelve$ "ML") (setq X1-2 (polar B1-2 (dtr 90) (/ Height~ 2.0)) Y1-2 (polar X1-2 0 Width~) Y1-2 (polar Y1-2 (dtr 270) Height~) );setq (setq Other$ "TC") (setq X2-3 (polar B2-3 pi (/ Width~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ (dtr 90))(= Side$ "Left")) (setq Dist~ (* HorizLeg~ (sin Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 0 HorizLeg~)) (setq B2-3 (polar B2 0 (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 90) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 90) DimGap~)) );if (setq Pt (polar B2 (dtr 270) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 270) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 pi DimGap~)) (setq Twelve$ "MR") (setq X1-2 (polar B1-2 (dtr 270) (/ Height~ 2.0)) Y1-2 (polar X1-2 pi Width~) Y1-2 (polar Y1-2 (dtr 90) Height~) );setq (setq Other$ "BC") (setq X2-3 (polar B2-3 0 (/ Width~ 2.0)) Y2-3 (polar X2-3 (dtr 90) Height~) Y2-3 (polar Y2-3 pi Width~) );setq );case ((and (< Ang1-2~ (dtr 135))(= Side$ "Right")) (setq Dist~ (* HorizLeg~ (cos (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 pi HorizLeg~)) (setq B2-3 (polar B2 pi (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 90) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 90) DimGap~)) );if (setq Pt (polar B2 (dtr 270) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 270) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 0 DimGap~)) (setq Twelve$ "ML") (setq X1-2 (polar B1-2 (dtr 90) (/ Height~ 2.0)) Y1-2 (polar X1-2 0 Width~) Y1-2 (polar Y1-2 (dtr 270) Height~) );setq (setq Other$ "BC") (setq X2-3 (polar B2-3 0 (/ Width~ 2.0)) Y2-3 (polar X2-3 (dtr 90) Height~) Y2-3 (polar Y2-3 pi Width~) );setq );case ((and (< Ang1-2~ (dtr 135))(= Side$ "Left")) (setq Dist~ (* HorizLeg~ (cos (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 0 HorizLeg~)) (setq B2-3 (polar B2 0 (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 270) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 270) DimGap~)) );if (setq Pt (polar B2 (dtr 90) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 90) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 pi DimGap~)) (setq Twelve$ "MR") (setq X1-2 (polar B1-2 (dtr 270) (/ Height~ 2.0)) Y1-2 (polar X1-2 pi Width~) Y1-2 (polar Y1-2 (dtr 90) Height~) );setq (setq Other$ "TC") (setq X2-3 (polar B2-3 pi (/ Width~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ pi)(= Side$ "Right")) (setq Dist~ (* VertiLeg~ (sin (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 270) VertiLeg~)) (setq B2-3 (polar B2 (dtr 270) (/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 0 DimGap~)) (setq Pt (polar B2 pi 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 pi (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 90) DimGap~)) (setq Twelve$ "BC") (setq X1-2 (polar B1-2 0 (/ Width~ 2.0)) Y1-2 (polar X1-2 (dtr 90) Height~) Y1-2 (polar Y1-2 pi Width~) );setq (setq Other$ "ML") (setq X2-3 (polar B2-3 (dtr 90) (/ Height~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ pi)(= Side$ "Left")) (setq Dist~ (* VertiLeg~ (sin (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 90) VertiLeg~)) (setq B2-3 (polar B2 (dtr 90) (/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 pi DimGap~)) (setq Pt (polar B2 0 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 0 (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 270) DimGap~)) (setq Twelve$ "TC") (setq X1-2 (polar B1-2 pi (/ Width~ 2.0)) Y1-2 (polar X1-2 0 Width~) Y1-2 (polar Y1-2 (dtr 270) Height~) );setq (setq Other$ "MR") (setq X2-3 (polar B2-3 (dtr 270) (/ Height~ 2.0)) Y2-3 (polar X2-3 pi Width~) Y2-3 (polar Y2-3 (dtr 90) Height~) );setq );case );cond (setq B1 (polar B1 AngSide~ BevelGap~) B2 (polar B2 AngSide~ BevelGap~) B3 (polar B3 AngSide~ BevelGap~) X1-2 (polar X1-2 AngSide~ BevelGap~) Y1-2 (polar Y1-2 AngSide~ BevelGap~) X2-3 (polar X2-3 AngSide~ BevelGap~) Y2-3 (polar Y2-3 AngSide~ BevelGap~) );setq (LayerOn Layer$) (command "PLINE" B1 B2 B3 "") (setq Ent1^ (entlast))(princ "\n") (setvar "TEXTSTYLE" TextStyle$) (setvar "TEXTSIZE" TextSize~) (setq TextStyleHeight~ (FindInList TextStyle$ (GetStyles) (GetStyleHeights))) (if (/= TextStyleHeight~ 0) (command "STYLE" TextStyle$ "" 0 "" "" "" "" (if (/= (getvar "CMDACTIVE") 0) "")) );if (if InchMark (command "MTEXT" X1-2 "J" Twelve$ Y1-2 "12\"" "") (command "MTEXT" X1-2 "J" Twelve$ Y1-2 "12" "") );if (setq Ent2^ (entlast)) (command "MTEXT" X2-3 "J" Other$ Y2-3 Bevel$ "") (setq Ent3^ (entlast)) (if (/= TextStyleHeight~ 0) (command "STYLE" TextStyle$ "" TextStyleHeight~ "" "" "" "" (if (/= (getvar "CMDACTIVE") 0) "")) );if (setq GroupName$ (UniqueName)) (command "GROUP" "C" GroupName$ "Bevel" Ent1^ Ent2^ Ent3^ "") (princ "\nSelect a line for Bevel Angle:\nSelect object:\nPick the location for Bevel:\n") );progn (princ "\nNo point selected.") );if );progn (princ "\nNo line or polyline selected for Bevel Angle.") );if );progn );if (ResetVars) (princ) );defun c:Bevel ;------------------------------------------------------------------------------- ; BV - Bevel programming function to draw a Bevel ; Arguments: 2 ; EntPick@ = Point on a line, polyline or dimension ; SidePick@ = Point on side of object to draw a Bevel ; Returns: Draws a Bevel based upon the two points ; Note: In programming, define the global variable *Bevel@ before running BV to ; ensure the correct Bevel settings as desired by the program. i.e. ; (setq *Bevel@ (list nil "DimText" "Romans - Romans" "0.0625" "0.03125" "0.03125" ; "Horizontal fraction" "Center" "75" "Yes" "Yes" "0.1094" "0.1893" "0.1226")) ; After customizing the Bevel Settings with c:BVS, type !*Bevel@ and cut and paste ; the list into your program. ;------------------------------------------------------------------------------- (defun BV (EntPick@ SidePick@ / Ang1-2~ AngSide~ B1 B2 B3 B1-2 B2-3 Bevel$ BevelAng~ BevelGap~ Clayer$ DimGap~ Dist~ Ent1^ Ent2^ Ent3^ EntList@ EntName^ EntPick@ EntType$ FracScale GroupName$ Height~ HorizLeg~ InchMark Ins Layer$ List@ NoBlank Other$ Position$ Pt Pt1 Pt2 Pt3 Pt4 Side$ Style$ TextSize~ TextStyle$ TextStyleHeight~ Twelve$ TxtSize~ TxtStyle$ VertiLeg~ Width~ X1-2 X2-3 Y1-2 Y2-3) (setq Clayer$ (getvar "CLAYER") TxtSize~ (getvar "TEXTSIZE") TxtStyle$ (getvar "TEXTSTYLE") );setq (if (not *Bevel@) (BevelData)) (setq Layer$ (nth 1 *Bevel@) TextStyle$ (nth 0 (WordList (nth 2 *Bevel@))) TextSize~ (* (atof (nth 3 *Bevel@))(getvar "DIMSCALE")) DimGap~ (* (atof (nth 4 *Bevel@)) (getvar "DIMSCALE")) BevelGap~ (* (atof (nth 5 *Bevel@))(getvar "DIMSCALE")) Style$ (nth 0 (WordList (nth 6 *Bevel@))) Position$ (nth 7 *Bevel@) FracScale (atoi (nth 8 *Bevel@)) NoBlank (if (= (nth 9 *Bevel@) "Yes") t nil) InchMark (if (= (nth 10 *Bevel@) "Yes") t nil) Height~ (* (atof (nth 11 *Bevel@)) (getvar "DIMSCALE")); 10 15/16"' Width~ (* (atof (nth 12 *Bevel@)) (getvar "DIMSCALE")); 10 15/16"' HorizLeg~ (* (atof (nth 13 *Bevel@)) (getvar "DIMSCALE")); 1 15/16" VertiLeg~ Height~ );setq (if (> HorizLeg~ VertiLeg~) (setq VertiLeg~ HorizLeg~)) (if (> VertiLeg~ HorizLeg~) (setq HorizLeg~ VertiLeg~)) (if (= Style$ "Unstacked") (setq HorizLeg~ (/ HorizLeg~ 2.0) VertiLeg~ (/ VertiLeg~ 2.0) );setq );if (if (ssget EntPick@) (progn (setq EntName^ (ssname (ssget EntPick@) 0) Point@ EntPick@ EntList@ (entget EntName^) EntType$ (cdr (assoc 0 EntList@)) );setq (if (or (= EntType$ "LINE")(= EntType$ "LWPOLYLINE")(= EntType$ "DIMENSION")) (progn (if (= EntType$ "LINE") (setq Pt1 (cdr (assoc 10 EntList@)) Pt2 (cdr (assoc 11 EntList@)) );setq (setq Pt1 (osnap Point@ "END") Pt2 (osnap Point@ "MID") Pt2 (polar Pt2 (angle Pt1 Pt2) (distance Pt1 Pt2)) );setq );if (setq Ang1-2~ (angle Pt1 Pt2)) (if (> Ang1-2~ pi) (progn (setq Ang1-2~ (- Ang1-2~ pi)) (setq Pt Pt1 Pt1 Pt2 Pt2 Pt) );progn );while (setq BevelAng~ (Bevel Ang1-2~)) (if (= Style$ "Unstacked") (if (= BevelAng~ 12) (if InchMark (setq Bevel$ "12\"") (setq Bevel$ "12") );if (if InchMark (setq Bevel$ (Arch BevelAng~)) (setq Bevel$ (substr (Arch BevelAng~) 1 (1- (strlen (Arch BevelAng~))))) );if );if (if (= BevelAng~ 12) (if InchMark (setq Bevel$ "12\"") (setq Bevel$ "12") );if (setq Bevel$ (Stacked BevelAng~ Style$ Position$ FracScale NoBlank InchMark)) );if );if (setq Pt3 SidePick@) (setq Pt4 (polar Pt3 (+ Ang1-2~ (* pi 0.5)) 1)) (setq Ins (inters Pt1 Pt2 Pt3 Pt4 nil)) (setq AngSide~ (angle Ins Pt3)) (setq Pt3 (polar Ins (angle Ins Pt3) 0.000001)) (if (> Ang1-2~ (angle Pt1 Pt3)) (setq Side$ "Right") (setq Side$ "Left") );if (cond ((and (< Ang1-2~ (dtr 45))(= Side$ "Right")) (setq Dist~ (* VertiLeg~ (cos Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 90) VertiLeg~)) (setq B2-3 (polar B2 (dtr 90) (/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 0 DimGap~)) (setq Pt (polar B2 pi 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 pi (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 270) DimGap~)) (setq Twelve$ "TC") (setq X1-2 (polar B1-2 pi (/ Width~ 2.0)) Y1-2 (polar X1-2 (dtr 270) Height~) Y1-2 (polar Y1-2 0 Width~) );setq (setq Other$ "ML") (setq X2-3 (polar B2-3 (dtr 90) (/ Height~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ (dtr 45))(= Side$ "Left")) (setq Dist~ (* VertiLeg~ (cos Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 270) VertiLeg~)) (setq B2-3 (polar B2 (dtr 270)(/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 pi DimGap~)) (setq Pt (polar B2 0 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 0 (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 90) DimGap~)) (setq Twelve$ "BC") (setq X1-2 (polar B1-2 0 (/ Width~ 2.0)) Y1-2 (polar X1-2 (dtr 90) Height~) Y1-2 (polar Y1-2 pi Width~) );setq (setq Other$ "MR") (setq X2-3 (polar B2-3 (dtr 270) (/ Height~ 2.0)) Y2-3 (polar X2-3 pi Width~) Y2-3 (polar Y2-3 (dtr 90) Height~) );setq );case ((and (< Ang1-2~ (dtr 90))(= Side$ "Right")) (setq Dist~ (* HorizLeg~ (sin Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 pi HorizLeg~)) (setq B2-3 (polar B2 pi (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 270) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 270) DimGap~)) );if (setq Pt (polar B2 (dtr 90) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 90) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 0 DimGap~)) (setq Twelve$ "ML") (setq X1-2 (polar B1-2 (dtr 90) (/ Height~ 2.0)) Y1-2 (polar X1-2 0 Width~) Y1-2 (polar Y1-2 (dtr 270) Height~) );setq (setq Other$ "TC") (setq X2-3 (polar B2-3 pi (/ Width~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ (dtr 90))(= Side$ "Left")) (setq Dist~ (* HorizLeg~ (sin Ang1-2~))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 0 HorizLeg~)) (setq B2-3 (polar B2 0 (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 90) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 90) DimGap~)) );if (setq Pt (polar B2 (dtr 270) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 270) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 pi DimGap~)) (setq Twelve$ "MR") (setq X1-2 (polar B1-2 (dtr 270) (/ Height~ 2.0)) Y1-2 (polar X1-2 pi Width~) Y1-2 (polar Y1-2 (dtr 90) Height~) );setq (setq Other$ "BC") (setq X2-3 (polar B2-3 0 (/ Width~ 2.0)) Y2-3 (polar X2-3 (dtr 90) Height~) Y2-3 (polar Y2-3 pi Width~) );setq );case ((and (< Ang1-2~ (dtr 135))(= Side$ "Right")) (setq Dist~ (* HorizLeg~ (cos (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 pi HorizLeg~)) (setq B2-3 (polar B2 pi (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 90) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 90) DimGap~)) );if (setq Pt (polar B2 (dtr 270) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 270) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 0 DimGap~)) (setq Twelve$ "ML") (setq X1-2 (polar B1-2 (dtr 90) (/ Height~ 2.0)) Y1-2 (polar X1-2 0 Width~) Y1-2 (polar Y1-2 (dtr 270) Height~) );setq (setq Other$ "BC") (setq X2-3 (polar B2-3 0 (/ Width~ 2.0)) Y2-3 (polar X2-3 (dtr 90) Height~) Y2-3 (polar Y2-3 pi Width~) );setq );case ((and (< Ang1-2~ (dtr 135))(= Side$ "Left")) (setq Dist~ (* HorizLeg~ (cos (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 0 HorizLeg~)) (setq B2-3 (polar B2 0 (/ HorizLeg~ 2.0))) (setq B2-3 (polar B2-3 (dtr 270) DimGap~)) (if (= Style$ "Unstacked") (setq B2-3 (polar B2 (dtr 270) DimGap~)) );if (setq Pt (polar B2 (dtr 90) 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 (dtr 90) (/ HorizLeg~ 2.0))) (setq B1-2 (polar B1-2 pi DimGap~)) (setq Twelve$ "MR") (setq X1-2 (polar B1-2 (dtr 270) (/ Height~ 2.0)) Y1-2 (polar X1-2 pi Width~) Y1-2 (polar Y1-2 (dtr 90) Height~) );setq (setq Other$ "TC") (setq X2-3 (polar B2-3 pi (/ Width~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ pi)(= Side$ "Right")) (setq Dist~ (* VertiLeg~ (sin (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 270) VertiLeg~)) (setq B2-3 (polar B2 (dtr 270) (/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 0 DimGap~)) (setq Pt (polar B2 pi 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 pi (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 90) DimGap~)) (setq Twelve$ "BC") (setq X1-2 (polar B1-2 0 (/ Width~ 2.0)) Y1-2 (polar X1-2 (dtr 90) Height~) Y1-2 (polar Y1-2 pi Width~) );setq (setq Other$ "ML") (setq X2-3 (polar B2-3 (dtr 90) (/ Height~ 2.0)) Y2-3 (polar X2-3 0 Width~) Y2-3 (polar Y2-3 (dtr 270) Height~) );setq );case ((and (< Ang1-2~ pi)(= Side$ "Left")) (setq Dist~ (* VertiLeg~ (sin (- Ang1-2~ (dtr 90))))) (setq B2 (polar Ins AngSide~ Dist~)) (setq B3 (polar B2 (dtr 90) VertiLeg~)) (setq B2-3 (polar B2 (dtr 90) (/ VertiLeg~ 2.0))) (setq B2-3 (polar B2-3 pi DimGap~)) (setq Pt (polar B2 0 1)) (setq B1 (inters B2 Pt Pt1 Pt2 nil)) (setq B1-2 (polar B2 0 (/ VertiLeg~ 2.0))) (setq B1-2 (polar B1-2 (dtr 270) DimGap~)) (setq Twelve$ "TC") (setq X1-2 (polar B1-2 pi (/ Width~ 2.0)) Y1-2 (polar X1-2 0 Width~) Y1-2 (polar Y1-2 (dtr 270) Height~) );setq (setq Other$ "MR") (setq X2-3 (polar B2-3 (dtr 270) (/ Height~ 2.0)) Y2-3 (polar X2-3 pi Width~) Y2-3 (polar Y2-3 (dtr 90) Height~) );setq );case );cond (setq B1 (polar B1 AngSide~ BevelGap~) B2 (polar B2 AngSide~ BevelGap~) B3 (polar B3 AngSide~ BevelGap~) X1-2 (polar X1-2 AngSide~ BevelGap~) Y1-2 (polar Y1-2 AngSide~ BevelGap~) X2-3 (polar X2-3 AngSide~ BevelGap~) Y2-3 (polar Y2-3 AngSide~ BevelGap~) );setq (LayerOn Layer$) (command "PLINE" B1 B2 B3 "") (setq Ent1^ (entlast))(princ "\n") (setvar "TEXTSTYLE" TextStyle$) (setvar "TEXTSIZE" TextSize~) (setq TextStyleHeight~ (FindInList TextStyle$ (GetStyles) (GetStyleHeights))) (if (/= TextStyleHeight~ 0) (command "STYLE" TextStyle$ "" 0 "" "" "" "" (if (/= (getvar "CMDACTIVE") 0) "")) );if (if InchMark (command "MTEXT" X1-2 "J" Twelve$ Y1-2 "12\"" "") (command "MTEXT" X1-2 "J" Twelve$ Y1-2 "12" "") );if (princ (strcat "\n" (chr 160) "\n" (chr 160))) (setq Ent2^ (entlast)) (command "MTEXT" X2-3 "J" Other$ Y2-3 Bevel$ "") (princ (strcat "\n" (chr 160) "\n" (chr 160) "\n" (chr 160))) (setq Ent3^ (entlast)) (if (/= TextStyleHeight~ 0) (command "STYLE" TextStyle$ "" TextStyleHeight~ "" "" "" "" (if (/= (getvar "CMDACTIVE") 0) "")) );if (setq GroupName$ (UniqueName)) (command "GROUP" "C" GroupName$ "Bevel" Ent1^ Ent2^ Ent3^ "") );progn );if );progn );if (setvar "CLAYER" Clayer$) (setvar "TEXTSIZE" TxtSize~) (setvar "TEXTSTYLE" TxtStyle$) (princ) );defun BV ;------------------------------------------------------------------------------- ; Bevel - Calculates bevel based upon radian angle of slope ; Arguments: 1 ; Radians~ = Radian angle ; Syntax: (Bevel 2) = 5.5 ; Returns: Bevel of radian angle ;------------------------------------------------------------------------------- (defun Bevel (Radians / Return~) (while (>= Radians (* pi 0.5)) (setq Radians (- Radians (* pi 0.5))) );while (cond ((= Radians 0) (setq Return~ 0) );case ((= Radians (* pi 0.25)) (setq Return~ 12) );case ((< Radians (* pi 0.25)) (setq Return~ (rtod (* 12 (tan Radians)) 4)) );case ((< Radians (* pi 0.5)) (setq Return~ (rtod (/ 12 (tan Radians)) 4)) );case );cond Return~ );defun Bevel ;------------------------------------------------------------------------------- ; Start of Bevel Support Utility Functions ;------------------------------------------------------------------------------- ; Capitals - Capitalizes the first letter of each group of letters in a String. ; Arguments: 1 ; Str$ = String ; Returns: String with the first letter of each group of letters capitalized. ;------------------------------------------------------------------------------- (defun Capitals (Str$ / Cnt# CapFlag Char$ Return$) (if (= (type Str$) 'STR) (progn (setq Str$ (strcase Str$ t)) (setq Cnt# 1 Return$ "") (while (<= Cnt# (strlen Str$)) (setq Char$ (substr Str$ Cnt# 1)) (if (or (= Char$ ".") (and (>= Char$ "a") (<= Char$ "z"))) (if CapFlag (setq Return$ (strcat Return$ Char$)) (progn (setq Return$ (strcat Return$ (strcase Char$))) (setq CapFlag t) );progn );if (progn (setq Return$ (strcat Return$ Char$)) (setq CapFlag nil) );progn );if (setq Cnt# (1+ Cnt#)) );while );progn );if Return$ );defun Capitals ;------------------------------------------------------------------------------- ; CommaList - Returns a list of Strings ; Arguments: 1 ; Str$ = String to convert into a list strings ; Syntax: (CommaList "1,2,3,4") = (list "1" "2" "3" "4") ; Returns: List of strings that were seperated by commas ;------------------------------------------------------------------------------- (defun CommaList (Str$ / List@ Num#) (while (setq Num# (vl-string-search "," Str$)) (setq List@ (cons (substr Str$ 1 Num#) List@) Str$ (substr Str$ (+ Num# 2)) );setq );while (reverse (cons Str$ List@)) );defun CommaList ;------------------------------------------------------------------------------- ; FindInList - Finds the associated Item from two lists ; Arguments: 3 ; Item = Item to find ; SearchList@ = List to search in ; InList@ = List used to return the nth where Item was found in SearchList@ ; Returns: The associated Item in InList@ ;------------------------------------------------------------------------------- (defun FindInList (Item SearchList@ InList@) (nth (- (length SearchList@) (length (member Item SearchList@))) InList@) );defun FindInList ;------------------------------------------------------------------------------- ; GetFonts - Gets the list of text fonts ;------------------------------------------------------------------------------- (defun GetFonts (/ Font$ FontList@ Fonts@ List@ Styles@ Table@) (setq Table@ (tblnext "STYLE" t)) (setq Styles@ (list (Capitals (cdr (assoc 2 Table@))))) (setq Font$ (FindReplace (Capitals (cdr (assoc 3 Table@))) ".shx" "")) (setq Fonts@ (list (FindReplace Font$ ".ttf" ""))) (while (setq Table@ (tblnext "STYLE")) (setq Styles@ (append Styles@ (list (Capitals (cdr (assoc 2 Table@)))))) (setq Font$ (FindReplace (Capitals (cdr (assoc 3 Table@))) ".shx" "")) (setq Fonts@ (append Fonts@ (list (FindReplace Font$ ".ttf" "")))) );while (setq List@ (acad_strlsort Styles@)) (foreach Style$ List@ (setq FontList@ (append FontList@ (list (FindInList Style$ Styles@ Fonts@)))) );foreach FontList@ );defun GetFonts ;------------------------------------------------------------------------------- ; GetLayers - Gets the list of layers ;------------------------------------------------------------------------------- (defun GetLayers (/ Layers@ Table@) (setq Table@ (tblnext "LAYER" t)) (setq Layers@ (list (cdr (assoc 2 Table@)))) (while (setq Table@ (tblnext "LAYER")) (setq Layers@ (append Layers@ (list (cdr (assoc 2 Table@))))) );while (acad_strlsort Layers@) );defun GetLayers ;------------------------------------------------------------------------------- ; GetLayerColors - Gets the list of layer colors ;------------------------------------------------------------------------------- (defun GetLayerColors (/ Colors@ Layer$ Layers@ LayerColors@ List@ Table@) (setq Table@ (tblnext "LAYER" t)) (setq Layers@ (list (cdr (assoc 2 Table@)))) (setq Colors@ (list (cdr (assoc 62 Table@)))) (while (setq Table@ (tblnext "LAYER")) (setq Layers@ (append Layers@ (list (cdr (assoc 2 Table@))))) (setq Colors@ (append Colors@ (list (cdr (assoc 62 Table@))))) );while (setq List@ (acad_strlsort Layers@)) (foreach Layer$ List@ (setq LayerColors@ (append LayerColors@ (list (FindInList Layer$ Layers@ Colors@)))) );foreach LayerColors@ );defun GetLayerColors ;------------------------------------------------------------------------------- ; GetStyles - Gets the list of text styles ;------------------------------------------------------------------------------- (defun GetStyles (/ Styles@ Table@) (setq Table@ (tblnext "STYLE" t)) (setq Styles@ (list (Capitals (cdr (assoc 2 Table@))))) (while (setq Table@ (tblnext "STYLE")) (setq Styles@ (append Styles@ (list (Capitals (cdr (assoc 2 Table@)))))) );while (acad_strlsort Styles@) );defun GetStyles ;------------------------------------------------------------------------------- ; GetStyleHeights - Gets the list of text style heights ;------------------------------------------------------------------------------- (defun GetStyleHeights (/ HeightList@ Heights@ List@ Styles@ Table@) (setq Table@ (tblnext "STYLE" t)) (setq Styles@ (list (Capitals (cdr (assoc 2 Table@))))) (setq Heights@ (list (cdr (assoc 40 Table@)))) (while (setq Table@ (tblnext "STYLE")) (setq Styles@ (append Styles@ (list (Capitals (cdr (assoc 2 Table@)))))) (setq Heights@ (append Heights@ (list (cdr (assoc 40 Table@))))) );while (setq List@ (acad_strlsort Styles@)) (foreach Style$ List@ (setq HeightList@ (append HeightList@ (list (FindInList Style$ Styles@ Heights@)))) );foreach HeightList@ );defun GetStyleHeights ;------------------------------------------------------------------------------- ; LayerOff - Turns a string of Layers off and frozen. ; Arguments: 1 ; LayerNames$ = String of layers separated by commas to turn off and frozen. ; Returns: Turns layers off and frozen. ;------------------------------------------------------------------------------- (defun LayerOff (LayerNames$) (if (= LayerNames$ "*") (command ".LAYER" "F" "*" "") (command ".LAYER" "OFF" LayerNames$ "F" LayerNames$ "") );if );defun LayerOff ;------------------------------------------------------------------------------- ; LayerOn - Insures that a layer is thawed, unlocked, and turned on before ; remaking it as the current layer. If LayName$ = "*" it thaws, unlocks, and ; turns on all layers. ; Arguments: 1 ; LayerNames$ = String of layers seperated by commas to turn on or make, and ; setting the last one as the current layer. ; Returns: Thaws, unlocks, turns on, and sets or makes LayerNames$. ;------------------------------------------------------------------------------- (defun LayerOn (LayerNames$ / LayerList@ Name$) (setq LayerList@ (CommaList LayerNames$)) (foreach Name$ LayerList@ (if (= Name$ "*") (command ".LAYER" "T" "*" "U" "*" "ON" "*" "") (if (tblsearch "layer" Name$) (command ".LAYER" "T" Name$ "U" Name$ "ON" Name$ "S" Name$ "") (command ".LAYER" "M" Name$ "") );if );if );foreach );defun LayerOn ;------------------------------------------------------------------------------- ; MtextLengths ;------------------------------------------------------------------------------- (defun MtextLengths (/ FractionStyle$ InchMark InsPt List@ NoBlank Osmode# Return@ Text$ TextStyle$ TextStyleHeight~) (setq InsPt (car (ViewExtents))) (setq TextStyle$ (nth 0 (WordList (nth 2 *Bevel@)))) (if (not (member TextStyle$ (GetStyles))) (setq TextStyle$ (nth 0 (GetStyles))) );if (setvar "TEXTSTYLE" TextStyle$) (setq TextStyleHeight~ (FindInList TextStyle$ (GetStyles) (GetStyleHeights))) (if (/= TextStyleHeight~ 0) (command "STYLE" TextStyle$ "" 0 "" "" "" "" (if (/= (getvar "CMDACTIVE") 0) "")) );if (setvar "TEXTSIZE" (atof (nth 3 *Bevel@))) (setq FractionStyle$ (nth 0 (WordList (nth 6 *Bevel@)))) (setq Osmode# (getvar "OSMODE")) (setvar "OSMODE" 0)(princ "\n") (if (= FractionStyle$ "Unstacked") (progn (setq InchMark (if (= (nth 10 *Bevel@) "Yes") "\"" "")) (setq Text$ (strcat "10 15/16" InchMark "'")) (command "TEXT" InsPt (getvar "TEXTSIZE") 0 Text$ "") (setq List@ (Text-Box (entlast))) (command "ERASE" (entlast) "") (setq Return@ (append Return@ (list (distance (nth 1 List@)(nth 2 List@))))) (setq Return@ (append Return@ (list (distance (nth 0 List@)(nth 1 List@))))) (setq Text$ (strcat "1 15/16" InchMark)) (command "TEXT" InsPt (getvar "TEXTSIZE") 0 Text$ "") (setq List@ (Text-Box (entlast))) (command "ERASE" (entlast) "") (setq Return@ (append Return@ (list (distance (nth 0 List@)(nth 1 List@))))) );progn (progn (setq NoBlank (if (= (nth 9 *Bevel@) "Yes") t nil)) (setq InchMark (if (= (nth 10 *Bevel@) "Yes") t nil)) (setq Text$ (Stacked "10 15/16" FractionStyle$ (nth 7 *Bevel@) (atoi (nth 8 *Bevel@)) NoBlank InchMark)) (setq Text$ (strcat Text$ "'")) (command "MTEXT" InsPt InsPt Text$ "") (setq List@ (Text-Box (entlast))) (command "ERASE" (entlast) "") (setq Return@ (append Return@ (list (distance (nth 1 List@)(nth 2 List@))))) (setq Return@ (append Return@ (list (distance (nth 0 List@)(nth 1 List@))))) (setq Text$ (Stacked "1 15/16" FractionStyle$ (nth 7 *Bevel@) (atoi (nth 8 *Bevel@)) NoBlank InchMark)) (command "MTEXT" InsPt InsPt Text$ "") (setq List@ (Text-Box (entlast))) (command "ERASE" (entlast) "") (setq Return@ (append Return@ (list (distance (nth 0 List@)(nth 1 List@))))) );progn );if (setvar "OSMODE" Osmode#) (if (/= TextStyleHeight~ 0) (command "STYLE" TextStyle$ "" TextStyleHeight~ "" "" "" "" (if (/= (getvar "CMDACTIVE") 0) "")) );if Return@ );defun MtextLengths ;------------------------------------------------------------------------------- ; ResetVars - Resets system variables to the settings saved by (SaveVars). ; Arguments: none ; Syntax: (ResetVars) ; Returns: Resets system variables saved by (SaveVars) and sets *SysVars* ; global variable to nil. ;------------------------------------------------------------------------------- (defun ResetVars () (if *SysVars* (foreach item *SysVars* (if (and (= (strcase (car item)) "DIMBLK")(= (cdr item) "")) (setvar "DIMBLK" ".") (setvar (car item)(cdr item)) );if );foreach );if (setq *SysVars* nil) (princ) );defun ResetVars ;------------------------------------------------------------------------------- ; rtod - Used to change a real number into decimal fractional number ; Arguments: 2 ; RealNum~ = Real number ; Precision# = Mode precision number equivalent to the rtos function. ; Syntax: (rtod 7.625 2) = 7.75 ; Returns: Real number rounded to the nearest decimal fractional number ; Precision: 0 = 1, 1 = 1/2, 2 = 1/4, 3 = 1/8, 4 = 1/16, 5 = 1/32, 6 = 1/64 etc. ;------------------------------------------------------------------------------- (defun rtod (RealNum~ Precision# / Fraction~ Minus#) (if (< RealNum~ 0) (setq Minus# -1) (setq Minus# 1) );if (setq RealNum~ (abs RealNum~)) (setq Fraction~ 1) (repeat (fix Precision#) (setq Fraction~ (/ Fraction~ 2.0)) );repeat (setq RealNum~ (+ RealNum~ (/ Fraction~ 2.0))) (* (* (fix (/ RealNum~ Fraction~)) Fraction~) Minus#) );defun rtod ;------------------------------------------------------------------------------- ; SaveVars - Saves the current state of a specified list of system variables. ; Arguments: 1 ; VarList = list of system variables to save ; Syntax: (SaveVars (list "clayer" "osmode" ["snapmode"...] )) ; Returns: Saves the global variable *SysVars* that contains an association ; list of the specified system variables and their current settings to save. ;------------------------------------------------------------------------------- (defun SaveVars (VarList) (foreach item VarList (setq *SysVars* (append *SysVars* (list (cons item (getvar item))))) );foreach );defun SaveVars ;------------------------------------------------------------------------------- ; Stacked - Converts a number into stacked format to update mtext and dimensions ; Arguments: 5 ; Number = A number as an integer, real, architecture or string ; Style$ = Diagonal or Horizontal ; Position$ = Top, Center or Bottom ; FracScale = Fraction Height Scale percent ; NoBlank = Remove leading blank before fraction ; InchMark = Add inch mark ; Syntax: (Stacked 12.75 "Horizontal" "Center" 75 t nil) = \A1;1'-0{\H0.75x;\S3/4;} ; Returns: Number converted into stacked format ;------------------------------------------------------------------------------- (defun Stacked (Number Style$ Position$ FracScale NoBlank InchMark / Fraction Inches Return$) (if (= (type Number) 'STR) (setq Number (stor Number)) );if (setq Style$ (if (= Style$ "Diagonal") "#" "/")) (setq Position$ (cond ((= Position$ "Top") "\\A2;") ((= Position$ "Center") "\\A1;") (t "");Bottom );cond );setq (setq FracScale (rtosr (* FracScale 0.01))) (setq NoBlank (if NoBlank "" " ")) (setq InchMark (if InchMark "\"" "")) (setq Inches (fix Number) Fraction (- Number Inches) );setq (if (= Fraction 0) (setq Return$ (Arch Inches)) (progn (if (> Inches 0) (setq Inches (Arch Inches) Inches (substr Inches 1 (1- (strlen Inches))) );setq (setq Inches "") );if (setq Fraction (FindReplace (Arch Fraction) "/" Style$) Fraction (substr Fraction 1 (1- (strlen Fraction))) Return$ (strcat Position$ Inches NoBlank "\{\\H" FracScale "x;\\S" Fraction ";\}" InchMark) );setq );progn );if Return$ );defun Stacked ;------------------------------------------------------------------------------- ; tan - Tangent of radian degrees ; Arguments: 1 ; radians = Radian degrees ; Returns: Tangent of radian degrees ;------------------------------------------------------------------------------- (defun tan (radians) (/ (sin radians) (cos radians)) );defun tan ;------------------------------------------------------------------------------- ; UniqueName - Creates a unique name for temp blocks and groups ;------------------------------------------------------------------------------- (defun UniqueName (/ Loop Name$) (setq Loop t) (while Loop (setq Name$ (rtos (getvar "CDATE") 2 8)) (setq Name$ (strcat (substr Name$ 4 5)(substr Name$ 10 8))) (if (/= Name$ *UniqueName$) (setq *UniqueName$ Name$ Loop nil) );if );while *UniqueName$ );defun UniqueName ;------------------------------------------------------------------------------- ; ViewExtents ; Returns: List of upper left and lower right points of current view ;------------------------------------------------------------------------------- (defun ViewExtents (/ A B C D X) (setq B (getvar "VIEWSIZE") A (* B (/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE")))) X (trans (getvar "VIEWCTR") 1 2) C (trans (list (- (car X) (/ A 2.0)) (+ (cadr X) (/ B 2.0))) 2 1) D (trans (list (+ (car X) (/ A 2.0)) (- (cadr X) (/ B 2.0))) 2 1) );setq (list C D) );defun ViewExtents ;------------------------------------------------------------------------------- ; Bevel_Support - Checks to see if supporting functions are loaded ;------------------------------------------------------------------------------- (defun Bevel_Support () (if (or (not GetOK)(not EditBox)(not Set_Value)(not ArchReal)(not Text-Box)) (progn (if (or (not GetOK)(not EditBox)) (if (findfile "GetIcon.lsp") (load "GetIcon.lsp") (if (findfile "Blk_Lib.lsp") (load "Blk_Lib.lsp") );if );if );if (if (or (not Set_Value)(not ArchReal)) (if (findfile "Dcl_Tiles.lsp") (load "Dcl_Tiles.lsp") );if );if (if (not Text-Box) (if (findfile "Text-Box.lsp") (load "Text-Box.lsp") );if );if (if (or (not GetOK)(not EditBox)(not Set_Value)(not ArchReal)(not Text-Box)) (progn (alert (strcat "Bevel requires the functions inside of GetIcon.lsp, Dcl_Tiles.lsp" "\nand Text-Box.lsp. Download the latest versions from" "\nAutoLISP Exchange, (URL: http://web2.airmail.net/terrycad).") );alert (exit) );progn );if );progn );if );defun Bevel_Support ;------------------------------------------------------------------------------- (princ)