;;; --------------------------------------------------------------------------- ;;; BankSlope.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; BANK AND SLOPE HATCHING ;;; ;;; PURPOSE ;;; Draws the scalloped run of lines that marks an earth bank on a site plan - ;;; between the top of a slope and its toe, long and short alternating, each ;;; one bowed the opposite way to its neighbour. ;;; ;;; Cuttings, embankments, pond edges, bunds, spoil heaps. Pick the top line, ;;; pick the bottom, and the hatching is laid between them. ;;; ;;; top of slope ;;; ____________________________ ;;; ) ( ) ( ) ( ) ( ) ( ) ;;; ) ) ) ) ) ) ;;; ____________________________ ;;; toe of slope ;;; ;;; HOW IT FOLLOWS THE SLOPE ;;; Each scallop is drawn between the top line and the bottom line at the ;;; point it happens to be, not to a fixed length. So where the bank is wide ;;; the scallops stretch and where it narrows they shorten, which is what ;;; makes the hatching read as a slope rather than a row of ticks. ;;; ;;; The alternating long and short is the convention: full length to the toe, ;;; then half, then full again. ;;; ;;; WHAT WAS FIXED ;;; - The scale came from USERR2, a general-purpose system variable being used ;;; as storage. Anything else in the drawing that used USERR2 for its own ;;; purposes silently changed the scallop size, and setting it here broke ;;; whatever that was. ;;; - The size routine ended by CALLING THE MAIN COMMAND - so changing the ;;; size started a whole new run rather than returning. Cancelling out of ;;; that left the first run's layer still current. ;;; - It built the scallops by drawing a run of separate PLINE objects, then ;;; joining them with PEDIT against a selection window, then walking the ;;; result setting bulges vertex by vertex. If the window happened to catch ;;; anything else, that got joined in too. The geometry is built directly ;;; now, with the bulge set as each vertex is written. ;;; - Ten variables were global despite a careful list of locals. ;;; - The current layer was restored by name, but only on the path where ;;; everything worked. ;;; ;;; BANKSLOPE - scalloped hatching between top and toe of a bank ;;; --------------------------------------------------------------------------- (setq *Bank:Size* nil) ;;; --------------------------------------------------------------------------- ;;; SUPPORT ;;; --------------------------------------------------------------------------- (defun Bank:Layer ( name colour ) (if (not (tblsearch "LAYER" name)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 name) '(70 . 0) (cons 62 colour) '(6 . "Continuous")))) name ) ;;; One scallop: a two-vertex polyline with a bulge, so it bows to one side. ;;; BULGE is the tangent of a quarter of the arc's included angle - a small ;;; value gives a gentle bow, and the sign says which way it leans. (defun Bank:Scallop ( p1 p2 bulge layer ) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 layer) '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) (cons 10 (list (car p1) (cadr p1))) (cons 42 bulge) (cons 10 (list (car p2) (cadr p2))) '(42 . 0.0))) ) ;;; Where a ray from P at right angles to the top line meets the bottom line. ;;; Returns nil if it misses, which is how a bank that runs past the end of its ;;; toe line stops rather than drawing off into space. (defun Bank:Foot ( p ang bottom / far ) (setq far (polar p ang 1e7)) (inters p far (car bottom) (cadr bottom) t) ) ;;; The two ends of a picked line. (defun Bank:Ends ( sel / d ) (setq d (entget (car sel))) (if (= "LINE" (cdr (assoc 0 d))) (list (cdr (assoc 10 d)) (cdr (assoc 11 d)))) ) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:BANKSLOPE ( / *error* vars vals sel top bottom size lay ang perp len d p foot n long v run ) (setq vars '("CMDECHO" "BLIPMODE" "OSMODE" "CLAYER") vals (mapcar 'getvar vars)) (defun Bank:Restore ( ) (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 ) (Bank:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** BANKSLOPE error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless ;; the routine says up front that it will use one. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") ;; --- the two edges of the bank ----------------------------------------- (setq top nil) (while (and (null top) (setq sel (entsel "\nTop of the slope : "))) (if (null (setq top (Bank:Ends sel))) (princ "\n That is not a line."))) (if (null top) (princ "\nCancelled.") (progn (setq bottom nil) (while (and (null bottom) (setq sel (entsel "\nToe of the slope : "))) (if (null (setq bottom (Bank:Ends sel))) (princ "\n That is not a line."))) (if (null bottom) (princ "\nCancelled.") (progn (setvar "OSMODE" 0) ;; --- spacing ------------------------------------------ (initget 6) (setq size (getdist (strcat "\nSpacing between scallops" (if *Bank:Size* (strcat " <" (rtos *Bank:Size* 2 3) ">") "") ": "))) (if (null size) (setq size *Bank:Size*)) (if (null size) (princ "\nNo spacing given.") (progn (setq *Bank:Size* size lay (Bank:Layer "Slope" 15) ang (angle (car top) (cadr top)) len (distance (car top) (cadr top))) ;; Which side the toe lies on, so the scallops run ;; the right way and not off into the drawing. (setq perp (+ ang (/ pi 2.0))) (if (> (distance (polar (car top) perp size) (car bottom)) (distance (polar (car top) (- perp pi) size) (car bottom))) (setq perp (- perp pi))) (setq d 0.0 n 0 long t run 0.0) (while (<= d len) (setq p (polar (car top) ang d) foot (Bank:Foot p perp bottom)) (if foot (progn ;; Long scallops reach the toe, short ;; ones stop half way - the alternation ;; is what makes it read as a bank. (Bank:Scallop p (if long foot (polar p (angle p foot) (/ (distance p foot) 2.0))) (if long 0.06 -0.06) lay) (setq n (1+ n) run (+ run (distance p foot))))) (setq long (not long) d (+ d size))) (if (zerop n) (princ (strcat "\n** Nothing drawn - the toe line does" " not lie opposite the top line." "\n They need to face each other. **")) (princ (strcat "\n" (itoa n) " scallops over " (rtos len 2 3) ", average slope width " (rtos (/ run n) 2 3) "."))) ) ) ) ) ) ) (Bank:Restore) (princ) ) (princ)