Add enclosed polyline below profile and auto hatch based on conditional slope

[Anonymous]

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. 

[Sea-Haven]

A couple of suggestions when you get &value it is a string and you may need a number so use (atof $value) if you want an integer use (atoi $value).

I will try to test your code.

[Sea-Haven]

This code is not correct as it needs more work but shows better how to integrate the dcl into the code. You do not need the dcl code in the lisp it is a separate file.

Missed some thing in dcl Hor scale Ver scale is required. John has done a good job, for me a different approach using the co-ords of the pline. The existing code needs a bit of re-work.

(vl-load-com)
(Defun ahctray ( / )
(setq dcl_id (load_dialog "C:\\Users\\cmanner\\Desktop\\CAD\\alantest.dcl"))
(if (not (new_dialog "ddgetvalAH" dcl_id))
(exit))
(action_tile "key1" "(setq slope1 (atof $value))")
(action_tile "key2" "(setq slope2 (atof $value))")
(action_tile "key3" "(setq slope3 (atof $value))")
(action_tile "key4" "(setq scale1 (atoi  $value))")
(action_tile "key5" "(setq depth1 (atof $value))")
(action_tile "key6" "(setq scale2 (atoi  $value))")
(action_tile "key7" "(setq Depth2 (atof $value))")
(action_tile "key8" "(setq scale3 (atoi  $value))")
(action_tile "key9" "(setq depth3 $value))")
(action_tile "B1" "(ahselhat)(ahsubdlg2)(setq H1 (nth newans call_lsth))")
(action_tile "B2" "(ahpicklay)(ahsubdlg2)(setq L1 (nth newans call_lstlay))")
(action_tile "B3" "(ahselhat)(ahsubdlg2)(setq H2 (nth newans call_lsth))")
(action_tile "B4" "(ahpicklay)(ahsubdlg2)(setq L2 (nth newans call_lstlay))")
(action_tile "B5" "(ahselhat)(ahsubdlg2)(setq H3 (nth newans call_lsth))")
(action_tile "B6" "(ahpicklay)(ahsubdlg2)(setq L3 (nth newans call_lstlay))")
(action_tile "accept" "(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
) ;defun

(defun c:hus ; = Hatches Under Slope
run it here 
(ahctray)
  (/ pline n p1 p2 slope)
  (setq
    pline (car (entsel "\nSelect slope profile Polyline: "))
    depth (getdist "\nVertical depth of under-Hatching: ")
use depth1 depth2 depth3 not required 
    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]

Needs to be rewritten so cond compares slope1 slope2 slope3 in correct order will work fine
; eg  ((< slope slope1) (command h1 scale1 0)); [shallow slope]
((alert "Slope exceeds specs \n Now exiting")(exit))

    ); 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
this cond is not needed if you set hatch pattern scale at time of creation
      (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

[Anonymous]

(vl-load-com)

(defun ahctray (/)
    
(if(not(setq dcl_id (load_dialog "dcl_edited.dcl"))) ;; load the dcl file
      (progn
	(alert "DCL File Could Not Be Loaded")
	(exit)
       ) ;progn
  
  (progn  ;;The dcl file was loaded
    
    (if (not (new_dialog "ddgetvalAH" dcl_id))  ;; load the definition
      	(progn
	  (alert "The File Definition Could Not Be Located")
	(exit)
         );progn

  (progn    

(setq hatchlist (list "AR-SAND" "GRAVEL" "SOLID" "ANGLE" "ANSI31" "ANSI32" "ANSI33" "ANSI34" "ANSI35" "ANSI36" "ANSI37" 
   "ANSI38" "AR-B816" "AR-B816C" "AR-B88" "AR-BRELM" "AR-BRSTD" "AR-CONC" "AR-HBONE" "AR-PARQ1" "AR-RROOF" "AR-RSHKE"
   "BOX" "BRASS" "BRICK" "BRSTONE" "CLAY" "CORK" "CROSS" "DASH" "DOLMIT" "DOTS" "EARTH" "ESCHER" "GRASS" "HEX" "HONEY"
   "HOUND" "MUDST" "NET" "NET3" "PLAST" "SACNCR" "SQUARE" "STARS" "STEEL" "SWAMP" "TRANS" "TRIANG" "ZIGZAG" "CATHEDRAL")
) ;setq ;; Hatches for dcl dropdown list

(setq layerlist (vlax-for 1(vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
    (setq oLst (cons (vla-get-Name 1)oLst))))
      ;; Should pull existing layers into dropdown list in dcl


(start_list "b1")
(mapcar 'add_list hatchlist)
(end_list)
(start_list "b3")
(mapcar 'add_list hatchlist)
(end_list)
(start_list "b5")
(mapcar 'add_list hatchlist)
(end_list)

(start_list "b2")
(mapcar 'add_list layerlist)
(end_list)
(start_list "b4")
(mapcar 'add_list layerlist)
(end_list)
(start_list "b6")
(mapcar 'add_list layerlist)
(end_list)

(action_tile "key1" "(setq slope2 (atof $value))")
(action_tile "key2" "(setq slope3 (atof $value))")
(action_tile "key4" "(setq scale1 (atoi  $value))")
(action_tile "key5" "(setq depth1 (atof $value))")
(action_tile "key6" "(setq scale2 (atoi  $value))")
(action_tile "key7" "(setq depth2 (atof $value))")
(action_tile "key8" "(setq scale3 (atoi  $value))")
(action_tile "key9" "(setq depth3 (atof $value))")

(action_tile "accept"(strcat "(progn (setq hatchlist (atof (get_tile \"b1\")))"
	"(done_dialog)(setq userclick1 T))"
	);strcat
       );action tile	

(action_tile "accept"(strcat "(progn (setq layerlist (atof (get_tile \"b2\")))"
	"(done_dialog)(setq userclick2 T))"
	);strcat
       );action tile

(action_tile "accept"(strcat "(progn (setq hatchlist (atof (get_tile \"b3\")))"
	"(done_dialog)(setq userclick3 T))"
	);strcat
       );action tile	

(action_tile "accept"(strcat "(progn (setq layerlist (atof (get_tile \"b4\")))"
	"(done_dialog)(setq userclick4 T))"
	);strcat
       );action tile

(action_tile "accept"(strcat "(progn (setq hatchlist (atof (get_tile \"b5\")))"
	"(done_dialog)(setq userclick5 T))"
	);strcat
       );action tile
	
(action_tile "accept"(strcat "(progn (setq layerlist (atof (get_tile \"b6\")))"
	"(done_dialog)(setq userclick6 T))"
	);strcat
       );action tile

(action_tile "accept" "(saveVars)(done_dialog)")  ;; save selected dropdown options ;;Do I need to create a saveVars routine?
(setq strtdlg (start_dialog))
(unload_dialog dcl_id)
      
       ) ;;progn "if all works start actions"
     )  ;; load definition "if" statement
   ) ;; progn "file loaded"
 ) ;;first "if" statement

  (defun c:ahctray (/ pline n p1 p2 slope dcl_load_id dcl_id depth1 depth2 depth3 slope2 slope3 h1 h2 h3 hatchlist userclick1
	userclick3 userclick5 strtdlg oLst layerlist)
    
(if (setq "dcl_id")
  (progn
     (setq
    pline (car (entsel "\nSelect slope profile Polyline: "))
    n 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)
    )
    );;progn
  );; if

   (command "_.hatch")
   (cond ;; hatch, scale and depth from DCL input
         ((< slope)(command "b1" depth1 scale1 0))
	 ((< slope slope2)(command "b2" depth2 scale2 0))
	 ((slope slope3)(command "b3" depth3 scale3 0))
   ) ;;cond	 

  (prompt
    (strcat
      "\nLow Slope total = " (rtos depth1) "."
      "\nMedium Slope total = " (rtos depth2) "."
      "\nSteep Slope total = " (rtos depth3) "."
    ); strcat
  ); prompt
  (princ)
)); defun

ddgetvalAH : dialog {
       
	label = "   Enter Hatch Parameters" ;
	
 : column {
 
 : boxed_row { label ="  Slope Range (ft/ft)" ;

 : spacer  { width = 20; }
 
: edit_box { key = "key1"; label = "Low (ft/ft) <";
                edit_width = 5; edit_limit = 5;
                fixed_width = true; alignment = centered; is_enabled = true ; }


: text     { label = "< Moderate (ft/ft) < ";
		alignment = centered; is_enabled = true; } 
                
: edit_box { key = "key2"; 
		edit_width = 5; edit_limit = 5;
                fixed_width = true; alignment = centered; is_enabled = true ; }
                
: text	   { label = "< High (ft/ft)";
		alignment = centered; is_enabled = true; }

: spacer  { width = 25; }
                } 
      
 : boxed_row {
   : text { label = "Low   "; }
        : spacer  { width =5; }
	: popup_list { key = "B1"; label = "Hatch";	}
	: spacer  { width = 8; }
	: popup_list { key = "B2"; label = "Layer ";}

	: spacer  { width = 0.6; }
: edit_box  { key = "key4";  label = "Scale      ";
                 edit_width = 5; edit_limit = 4; fixed_width = true; is_enabled = true ;}
                 
: edit_box {  key = "key5";  label = "Depth";
                 edit_width = 5; edit_limit = 4; fixed_width = true; is_enabled = true ;}
                 }
				
: boxed_row {
   : text { label = "Moderate   "; }
        : spacer  { width = 0.6; }
        : popup_list { key = "B3"; label = "Hatch";	}
	: spacer  { width = 8.5; }
	: popup_list { key = "B4"; label = "Layer ";}

	: spacer  { width = 0.7; }
: edit_box {  key = "key6";  label = "Scale      ";
                 edit_width = 5; edit_limit = 4; fixed_width = true; is_enabled = true ;}
                 
: edit_box {  key = "key7";  label = "Depth";
                 edit_width = 5; edit_limit = 4; fixed_width = true; is_enabled = true ;}
	        }
	        
 : boxed_row {
  : text { label = "High    "; }
        : spacer  { width = 4.5; }
	: popup_list { key = "B5"; label = "Hatch";}
	: spacer  { width = 8; }
	: popup_list { key = "B6"; label = "Layer ";}

	: spacer  { width = 0.6; }
: edit_box {  key = "key8"; label = "Scale      ";
                 edit_width = 5; edit_limit = 4; fixed_width = true; is_enabled = true ;}
                 
: edit_box {  key = "key9"; label = "Depth";
                 edit_width = 5; edit_limit = 4; fixed_width = true; is_enabled = true ;}
		}
			}

        ok_cancel ; }

    Well, I have spent the last couple weeks trying to learn more lisp and more dcl. Inbetween work and more work, ive come a long way I think. I am still stuck, something Im doing is wrong, but you can see Ive really progressed from where I started. 

 At t his point im still struggling to make this work. The dialog box looks awesome now, im happy with it. I think i've figured out how to get the hatch and layers. I guess tying it all together has been difficult. Im also not sure if I need to write a "saveVars" routine? 

  Any more tips or assistance would be very appreciated.