Create Hatch below profile and layer dependent of slope

[fedupsumhow]

   Hey everyone,

  I am new to writing lisp routines, what I am needing to do is: create hatching that follows below a profile and have the hatching layer conditional dependent on the slope of the profile. 

  Essentially what is happening, we have material that needs to be placed but the material size varies depending on the slope. Slope between 0-5% uses finer material, 6-15% a little denser and anything over 15% is a very dense and large material. We need to show the contractors a hatch that runs below the profile and changes hatch pattern depending on what the slope grade is. The two projects we have to do this for are extremely large and manually hatching would take forever. 

  I've tried to find/create a lisp to do this, but it gets a little complex for me. Any ideas?

 

 Thanks

[BIGAL]

Need an example dwg for any one here to look at.

[fedupsumhow]

 Sorry, here is a picture of what I mean. 

So I have a profile and I have slope labels assigned to the profile. Depending on the slope, we use a different consistency material. We want to show that difference by adding hatch (similar to the highlighter below) that changes hatch consistency (or layer) based on conditional slope grades. 

So what im trying to do is create a lisp where I can click on the profile and it will automatically add the hatch and change the layer/hatch based off the conditional slope grade. 

[fedupsumhow]

[CODE]

;select point on proposed bed profile


;create rectangle/polyline
  
  (defun c:hoff (/ cl dist hi e p1 ss pt)
      (setq echo (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (setq cl (getvar "clayer"))
      (if (setq dist (cond ((getdist (strcat "\n Specify offset distance <"
                                         (rtos (if (not hi)
                                                 (setq hi 0.5)
                                               )
                                               2
                                               2
                                         )
                                         ">:"
                                 )
                        )
                       )
                       (t hi)
                 )
          )
        (progn (setq hi dist)
           (if (not (tblsearch "LAYER" "CLASHING_HATCH"))
             (entmakex '((0 . "LAYER")
                         (100 . "AcDbSymbolTableRecord")
                         (100 . "AcDbLayerTableRecord")
                         (2 . "CLASHING_HATCH")
                         (70 . 0)
                         (62 . 140)
                         (6 . "Continuous")
                        )
             )
           )
           (command "_-layer" "on" "CLASHING_HATCH" "")
           (command "_-layer" "thaw" "CLASHING_HATCH" "")       
           (setvar 'clayer "CLASHING_HATCH")
           (setq e (entsel "\nSelect object to offset: "))
           (command "._COPY" e "" "" "")
           (setq f (car e))
           (setq p1 (getpoint "\n Side to offset? "))
           (command "_.offset" "_Layer" "_Current" dist f p1 "")
           (progn (setq b (entlast))
                  (setvar "peditaccept" 1)
                  (command "pedit" "m" "l" e "" "j" "j" "a" "2" "")
           )
           ;; progn
        )
      )
    ;;;;;;;;;;;;;;;;;;;
      (setq el (entlast))
      ;; Selection set of objects to hatch
      (setq ss (ssadd))
      (ssadd f ss)
      (ssadd b ss)
      (command "_-boundary" p1 "")
      (if (/= el (entlast))
        (command "_-hatch" "_S" ss "" "_P" "ANSI31" "0.025" "90" "_T" "60" "_DR" "B" "_LA" "HATCH" "")
      )
 
 ;(command "erase" el "")
      ;; Put offset object on defpoints layer rather than erase  ;; pb i'm sticking them on a layer which gets deleted once a drawing if finalised
;      (entmod (subst '(8 . "defpoints") (assoc 8 (entget el)) (entget el)))
 
    ;;;;;;;;;;;;;;;;;;;
      (setvar 'cmdecho echo)
      (setvar "clayer" cl)
(command "_-layer" "off" "CLASHING_HATCH" "")
      (princ)
    )

;make hatch layer conditional upon slope percent

  (cond ((= >5% Profile label "lines") (setq 8. "G-MATC-LINE")))
    (cond (( =<5% Profile label "lines") (setq 8. "G-PROF-TTLB")))

;print total length of each individual hatch layers
)[/CODE]

   Here is a piece of code i found that does sort of what i need. The issues with this are that first, it doesnt allow me to select a profile, only a polyline. Second, id like to add the conditional statements that change the hatch depending on grade of slope. Any ideas?

 

Edited October 16, 2019 by fedupsumhow

[BIGAL]

Using a polyline is faster than picking each section. It would be easy to make a hatch of a fixed shape so ends are vertical, using pline segments.

 

As no dwg need some answers for some simple questions.

Vertical Depth of hatch.

Most important some suggestion of colors 1-1.9999 blue, 2-2.999 green and so on.

[fedupsumhow]

(vl-load-com)
(defun C:HUS ; = Hatches Under Slope
  (/ pline n p1 p2 slope)
  (setq
    pline (car (entsel "\nSelect slope profile Polyline: "))
    depth (getdist "\nVertical depth of under-Hatching: ")
    n 0
    LowSlopeDist 0
    MedSlopeDist 0
    SteepSlopeDist 0
  ); setq
  (repeat (1- (cdr (assoc 90 (entget pline))))
    (setq
      p1 (vlax-curve-getPointAtParam pline n)
      p2 (vlax-curve-getPointAtParam pline (setq n (1+ n)))
      slope (/ (abs (- (cadr p1) (cadr p2))) (abs (- (car p1) (car p2))) 10)
    )
    (command  "_.hatch")
    (cond ;;; EDIT pattern scales
      ((< slope 0.05) (command "AR-SAND" 0.9 0)); [shallow slope]
      ((< slope 0.1) (command "GRAVEL" 4 0)); [medium slope]
      ((command "GRAVEL" 8 0)); [steep slope]
    ); cond
    (command "" "_no"
        ;; direct-draw boundary, don't keep it
      "_none" p1
      "_none" p2
      "_none" (polar p2 (* pi 1.5) depth)
      "_none" (polar p1 (* pi 1.5) depth)
      "_close"
      ""
    ); command
    (setq which
      (cond ;;; EDIT pattern scales
        ((< slope 0.05) 'LowSlopeDist); [shallow slope]
        ((< slope 0.1) 'MedSlopeDist); [medium slope]
        ('SteepSlopeDist); [steep slope]
      ); cond
    ); setq
    (set which
      (+
        (eval which) ; value so far
        (sqrt (+ (expt (/ (- (cadr p1) (cadr p2)) 10) 2) (expt (- (car p1) (car p2)) 2)))
          ;; length of segment, corrected for vertical exaggeration
      ); +
    ); set
  ); repeat
  (prompt
    (strcat
      "\nLow Slope total = " (rtos LowSlopeDist) "."
      "\nMedium Slope total = " (rtos MedSlopeDist) "."
      "\nSteep Slope total = " (rtos SteepSlopeDist) "."
    ); strcat
  ); prompt
  (princ)
); defun

  Here is the lisp I was trying to figure out. Someone in the autodesk forum was able to assist but I wanted to put this here in case anyone ever needs it and so you can see what I meant.