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.
(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
); 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 [and rotations if desired]
((< slope 0.05) (command "AR-SAND" 2 0)); [shallow slope]
((< slope 0.1) (command "GRAVEL" 5 0)); [medium slope]
((command "GRAVEL" 10 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
); repeat
(princ)
); defun
@Anonymous wrote:
.... Is it possible to have a function that also adds us the total length of each individual hatch?....
Minimally tested, but I think this does it:
(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" 2 0)); [shallow slope]
((< slope 0.1) (command "GRAVEL" 5 0)); [medium slope]
((command "GRAVEL" 10 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
It leaves the totals in those three variables, if you want to use them for further calculations. It reports them to you in current Linear Units mode and precision settings -- you can alter that by adding mode and precision arguments to the (rtos) functions.
Hello again, Im messaging back here since you are already familiar with what I am doing. This may be asking too much but I would feel silly not asking at all.
I've tried for the past week to do this myself but its wayyyyy out of my level of lisp. Ive learned alot but this is still beyond me.
I am wanting to create a dummy proof prompt box that asks several questions and then after hitting continue, asks to select the profile and then adds the hatch conditional on what the user manually input.
So the image below is the layout of the dialog box. The first three letters "L M H" would prompt the user to insert the grade variable.
" ((< 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""
Basically asking that.
Then a drop-down menu or something that opens the layer menu, then again with the hatch choice and then boxes to add the scale size and depth below the profile.
They can be defaulted to the things we chose in original lisp, but I guess this lisp is so great, multiple offices want to use it and unfortunately not everyone understands lisp and/or feels comfortable adjusting in the lisp routine.
So Ive been trying hard to create this prompt/dialog box. Ive found skeleton code for dialog boxes but couldnt seem to get things working. So I caved and came back here.
What do you think?
With all the routines I've written, unfortunately I've never gotten into the DCL thing [i.e. it's above my level, too...]. It's conceivable I could start to explore it for this, but if there's someone already versed in it that can jump in, it would probably get you results sooner than I'll be able to work it out.
So, we are trying to generate DCL for this code. Unfortunately this code doesn't work correctly in Acad 2014.
I don't have time to play with this and to do changes upon every request (sorry),and I don't want to change @Kent1Cooper 's code.
Partial solution to this request is through an init function that asks for parameters that can be done through console input. It may call for a hatch pattern selection and here is my code.
To select appropriate hatch patterns you may use this code. It searches through "acad.pat" pattern definition file and collects all available hatch patterns, create DCL dynamically, and returns a list with selected pattern names.
It case selected on above picture function (get_hatch_dialog) would return ("GRAVEL" "AR-SAND" "AR-CONC").
(vl-load-com)
;https://forums.augi.com/showthread.php?96036-Tblsearch-on-hatch-pattern-file
(defun gethatchlin (acadftype / lino l1 commapos alllist)
(setq hatchlist nil
alllist nil
)
(if (setq fullpat (findfile acadftype))
(progn (setq lino (open fullpat "r"))
(while (setq l1 (read-line lino))
(if (and (eq (substr l1 1 1) "*")
(setq commapos (vl-string-search "," l1))
)
(setq alllist (append alllist (list (substr l1 2 (1- commapos)))))
)
)
)
)
(close lino)
(if alllist
(setq hatchlist (mapcar 'strcase alllist))
)
)
(defun get_hatch_dialog ( / file f dcl_id patterns ret rr)
(defun *error* ( m )
(if (and file (findfile file))(vl-file-delete (findfile file)))
(if m(prompt m))
(princ)
)
(setq file (vl-filename-mktemp "hhh.dcl"))
(setq f (open file "w"))
(write-line "ch : dialog {label = \"Select drafting parameters \"; width = 80; : column { : boxed_column { " f)
(write-line ": popup_list {key = \"l_list\";label = \"Low slope hatch pattern: \";fixed_width_font = true;width = 30; value = \" \";}" f)
(write-line ": popup_list {key = \"m_list\";label = \"Middle slope hatch pattern: \";fixed_width_font = true;width = 30; value = \" \";}" f)
(write-line ": popup_list {key = \"h_list\";label = \"High slope hatch pattern: \";fixed_width_font = true;width = 30; value = \" \";}" f)
(write-line "} ok_cancel;}}" f)
(close f)
(vla-regen (vla-get-activedocument (vlax-get-acad-object)) acactiveviewport)
(setq dcl_id (load_dialog file))
(if (not (new_dialog "ch" dcl_id)) (exit))
(setq patterns (gethatchlin "acad.pat"))
(start_list "l_list" 3)
(mapcar 'add_list patterns)
(end_list)
(start_list "m_list" 3)
(mapcar 'add_list patterns)
(end_list)
(start_list "h_list" 3)
(mapcar 'add_list patterns)
(end_list)
(action_tile "accept" "(setq rr(list (get_tile \"l_list\")(get_tile \"m_list\")(get_tile \"h_list\")))(done_dialog)");action tile
(action_tile "cancel" "(done_dialog)");action_tile
(start_dialog)
(unload_dialog dcl_id)
(setq rr (mapcar 'atoi rr))
(foreach r rr (setq ret (cons (nth r patterns) ret)))
(reverse ret)
)
Miljenko Hatlak
You may play with this code and it's relatively easy to create stuff you ask for. It something like:
(defun c:init() (setq lslope (getreal "\n Low slope inclination")) (setq mslope (getreal "\n Middle slope inclination")) (setq hslope (getreal "\n High slope inclination")) (setq hatches (get_hatch_dialog)) (setq lscale (getreal "\n Low slope hatch scale")) (setq mslope (getreal "\n Middle hatch scale")) (setq hslope (getreal "\n High hatch scale")) ;these are all global variables that should be called from hus function
User would use this before he starts hus function.
You may play with dcl file as well. Your main goal should be to learn autolisp. You have to edit main function to collect this globals, and this is an simple task.
Miljenko Hatlak
