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.
Let start with something since there is no answers yet. Until we get more informations here is a simple code.
It creates hatch area under section of the slope. It fills are with solid hatch. If you want more automation I would nead to know name of the layers ....
This could be automatized if all segments are streight lines. At the moment code asks you to pick two points of slope segment and it creates hatched area beneth that section of a height you state at first iteration.
So, create your layers depending on slope grade, and after you finish just change layer acordingly.
Hope you like the concept. For more automation I would need names of layers and slope grade limits to make filtering.
(setq dy nil) (defun c:hh () (defun *error* () (setvar "osmode" old) ) (setq old (getvar "OSMODE")) (setvar "osmode" 1) (setvar "cmdecho" 0) (if (not dy) (setq dy (getreal "\n Vertical offset for hatch area >"))) (setq p1 (getpoint "\nSelect first point of section segment >") p2 (getpoint "\nSelect second point of section segment >") p3 (mapcar '- p2 (list 0 dy)) p4 (mapcar '- p1 (list 0 dy)) ) (entmakex (apply 'append (cons (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) '(67 . 0) '(70 . 1) ) (mapcar 'list (mapcar '(lambda ( a ) (cons 10 a)) (list p1 p2 p3 p4))) ) ) ) (command "_.hatch" "solid" (entlast) "" ) (setvar "osmode" old) (setvar "cmdecho" 0) (princ) )
Miljenko Hatlak
Here is a version that creates hatch elements through whole polyline length, for all segments. To finish it I need info how to group them regarding slope grades and names of layers. Also what height of hatching below polyline would you like. I hope you make drawing in unit-less mode without initial scaling.
To run it type hh2 in command console.
If you like this you may set it ass final solution and I'll do all further adjustments and final polishing.
(setq dy nil)
(defun c:hh2 ( / equalPoints lwpolypoints *error* old pts p1 p2 p3 p4 )
(defun equalPoints ( pt1 pt2 ) (apply 'and (mapcar '= pt1 pt2)))
(defun lwpolypoints ( e / ent elev ptlist closed pt pt1 )
(setq
ent (entget e)
elev (cdr (assoc 38 ent))
closed (cdr (assoc 70 ent))
pt1 (cdr (assoc 10 ent))
)
(while (setq ent (member (assoc 10 ent) ent) pt (car ent) ent (cdr ent))
(setq p (list (cadr pt) (caddr pt) elev))
(if (atom ptlist) (setq ptlist (cons p ptlist)))
(if (and (listp ptlist) (not (equalPoints (car ptlist) p))) (setq ptlist (cons p ptlist)))
)
(if (and (= 1 (logand closed 1)) (not (equalPoints (car ptlist) pt1))) (setq ptlist (cons pt1 ptlist)))
(reverse ptlist)
)
(defun *error* ()(setvar "osmode" old) (setq "chmode" oldch))
(setq old (getvar "OSMODE"))
(setq oldch (getvar "CNDECHO"))
(setvar "osmode" 1)
(setvar "cmdecho" 0)
(if (not dy) (setq dy (getreal "\n Vertical offset for hatch area >")))
(setq pts (lwpolypoints (car (entsel "Select slope lwpolyline >"))))
(repeat (- (length pts) 1)
(setq p1 (car pts) p2 (cadr pts) pts (cdr pts)
p3 (mapcar '- p2 (list 0 dy))
p4 (mapcar '- p1 (list 0 dy))
)
(entmakex
(apply 'append
(cons
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 4)
'(67 . 0)
'(70 . 1)
)
(mapcar 'list (mapcar '(lambda ( a ) (cons 10 a)) (list p1 p2 p3 p4)))
)
)
)
(command "hatch" "p" "s" "s" (entlast) "" "")
)
(setvar "osmode" old)
(setvar "cmdecho" oldch)
(princ)
)
Miljenko Hatlak
Yes, that's all that has to be added, plus correction of hatch width depending on slope to have it constant through whole profile length. And maybe some minor corrections. But lets wait for @Anonymous responce.
Miljenko Hatlak
And here is version tha takes into account horizontal and vertical scaling, calculates and creates slope text in the middle of each segment. You have to test it if it gives good results. After that if all goes well we have to filter hatches regarding the slope. If you want to use some particular pattertn ("gravel" ot what ever) that changes depending on slope grade, update it.
(setq dy nil ) (defun c:hh2 ( / equalPoints lwpolypoints *error* old pts p1 p2 p3 p4 bound oldch dd dh dv gr grstr slope ) (defun equalPoints ( pt1 pt2 ) (apply 'and (mapcar '= pt1 pt2))) (defun lwpolypoints ( e / ent elev ptlist closed pt pt1 ) (setq ent (entget e) elev (cdr (assoc 38 ent)) closed (cdr (assoc 70 ent)) pt1 (cdr (assoc 10 ent)) ) (while (setq ent (member (assoc 10 ent) ent) pt (car ent) ent (cdr ent)) (setq p (list (cadr pt) (caddr pt) elev)) (if (atom ptlist) (setq ptlist (cons p ptlist))) (if (and (listp ptlist) (not (equalPoints (car ptlist) p))) (setq ptlist (cons p ptlist))) ) (if (and (= 1 (logand closed 1)) (not (equalPoints (car ptlist) pt1))) (setq ptlist (cons pt1 ptlist))) (reverse ptlist) ) (defun *error* ()(setq "chmode" oldch) (princ)) (setq oldch (getvar "cmdecho")) (setvar "cmdecho" 0) (if (not dy) (setq dy (getreal "\n Vertical offset for hatch area >"))) (setq pts (lwpolypoints (car (entsel "\nSelect slope lwpolyline >")))) (repeat (- (length pts) 1) (setq p1 (car pts) p2 (cadr pts) pts (cdr pts) p3 (mapcar '- p2 (list 0 dy)) p4 (mapcar '- p1 (list 0 dy)) dd (mapcar '- p2 p1) dv (* 0.01 (cadr dd)) dh (* 0.1 (car dd)) gr (* 100.0 (/ dv dh)) grstr (strcat (rtos gr 2 2) "%") ang (angle p1 p2) bound (entmakex (apply 'append (cons (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) '(67 . 0) '(70 . 1) ) (mapcar 'list (mapcar '(lambda ( a ) (cons 10 a)) (list p1 p2 p3 p4))) ) ) ) slope (entmakex (list '(0 . "TEXT") (cons 10 (mapcar '* (mapcar '+ p1 p2) (list 0.5 0.5))) '(40 . 15) (cons 50 ang) (cons 1 grstr) ) ) ) (command "_.hatch" "p" "s" "s" (entlast) "") (command "_.draworder" (entlast) "" "b") (entdel bound) ) (setvar "cmdecho" oldch) (princ) )
Miljenko Hatlak
Corrected
(setq dy nil ) (defun c:hh2 ( / equalPoints lwpolypoints *error* old pts p1 p2 p3 p4 bound oldch dd dh dv gr grstr slope ) (defun equalPoints ( pt1 pt2 ) (apply 'and (mapcar '= pt1 pt2))) (defun lwpolypoints ( e / ent elev ptlist closed pt pt1 ) (setq ent (entget e) elev (cdr (assoc 38 ent)) closed (cdr (assoc 70 ent)) pt1 (cdr (assoc 10 ent)) ) (while (setq ent (member (assoc 10 ent) ent) pt (car ent) ent (cdr ent)) (setq p (list (cadr pt) (caddr pt) elev)) (if (atom ptlist) (setq ptlist (cons p ptlist))) (if (and (listp ptlist) (not (equalPoints (car ptlist) p))) (setq ptlist (cons p ptlist))) ) (if (and (= 1 (logand closed 1)) (not (equalPoints (car ptlist) pt1))) (setq ptlist (cons pt1 ptlist))) (reverse ptlist) ) (defun *error* ()(setq "chmode" oldch) (princ)) (setq oldch (getvar "cmdecho")) (setvar "cmdecho" 0) (if (not dy) (setq dy (getreal "\n Vertical offset for hatch area >"))) (setq pts (lwpolypoints (car (entsel "\nSelect slope lwpolyline >")))) (repeat (- (length pts) 1) (setq p1 (car pts) p2 (cadr pts) pts (cdr pts) p3 (mapcar '- p2 (list 0 dy)) p4 (mapcar '- p1 (list 0 dy)) dd (mapcar '- p2 p1) dv (* 0.01 (cadr dd)) dh (* 0.1 (car dd)) gr (* 100.0 (/ dv dh)) grstr (strcat (rtos gr 2 2) "%") ang (angle p1 p2) bound (entmakex (apply 'append (cons (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) '(67 . 0) '(70 . 1) ) (mapcar 'list (mapcar '(lambda ( a ) (cons 10 a)) (list p1 p2 p3 p4))) ) ) ) ) (command "_.hatch" "p" "s" "s" (entlast) "") (command "_.draworder" (entlast) "" "b") (entmakex (list '(0 . "TEXT") (cons 10 (mapcar '* (mapcar '+ p1 p2) (list 0.5 0.5))) '(40 . 15) (cons 50 ang) (cons 1 grstr) ) ) (entdel bound) ) (setvar "cmdecho" oldch) (princ) )
Miljenko Hatlak
I think this can be a lot simpler. There's no need to draw Polyline outlines of the under-slope shading and then fill them with Solid Hatch patterns. Just use SOLIDs. Try this:
(vl-load-com)
(defun C:SUS ; = Solids Under Slope
(/ pline n p1 p2 slope)
(setq
pline (car (entsel "\nSelect slope profile Polyline: "))
depth (getdist "\nVertical depth of under-shading: ")
n 0
); setq
(repeat (1- (cdr (assoc 90 (entget pline))))
(command "_.solid"
"_none" (setq p1 (vlax-curve-getPointAtParam pline n))
"_none" (polar p1 (* pi 1.5) depth)
"_none" (setq p2 (vlax-curve-getPointAtParam pline (setq n (1+ n))))
"_none" (polar p2 (* pi 1.5) depth)
""
); command
(setq slope (/ (abs (- (cadr p1) (cadr p2))) (abs (- (car p1) (car p2)))))
(command "_.chprop" "_last" "" "_layer"
(cond ;; EDIT numerical cut-off values and Layer names, and/or add categories
((<= slope 0.25) "LowSlopeLayer")
((<= slope 0.5) "MediumSlopeLayer")
("SteepSlopeLayer")
); cond
""
); command
); repeat
(princ)
); defun
It assumes the Layers already exist, and that the Polyline will be of line segments and will not be closed, and with no vertical segments [which cause a divide-by-zero error]. It could easily be made to assign override colors, rather than put the Solids on Layers, if preferred.
You will need to determine the slope percentages that fit the categories of steepness that you need to divide things into. You can add more categories as desired. I get this from setting up a similar situation:
If it does what you want, it can be enhanced in various ways [error handling, undo begin-end wrapping, command-echo suppression, etc.], and could remember your depth and offer it as default on subsequent use [or the depth could be hard-coded in, if appropriate to your process].
1) @Anonymous - "to show that difference by adding hatch (similar to the highlighter below) that changes hatch consistency (or layer)"
I guess she wants to use hatch pattern with different scale factor ("gravel"). Then using solid doesn't work
2) Horizontal and vertical scale are different
3) One may use hatch with different color, instead of layers.
@Kent1CooperYou may finish this, I'm done with it.
Miljenko Hatlak
@Anonymous wrote:
.... I keep getting an error message after it asks for my second point "vertical depth of under-shading; specify second point; error bad argument type ; number nil"
I suspect that's really "numberp nil", but in any case....
The thing that looks for a number that could be getting nil instead is probably the number of repeats, that is:
(1- (cdr (assoc 90 (entget pline))))
That's pulling the number of vertices in a "lightweight" Polyline, and subtracting 1 for the number of segments for one that is not closed. It requires that a LWPolyline is selected. If you are picking on a "heavy" Polyline, or just a Line, there won't be an entry like that to get a number of repeats from.
The routine could be made to verify that you picked the right kind of thing, or even to work with those other entity types, if necessary. But first try it with a real LWPolyline, and see whether it works for you.
The error was in
(setq "chmode" oldch)
It should be chmode without "". In my program based on acad it doesn't lift an error. In acad2014 it has prompted me a syntax error.
Try the code and then take some time an try to write down what and how you really want to have it implemented.
I'm doing this kind of job for 20 years (geotechnical engineer) and I may guess what you looking for but be more precise.
a) Name of the layers and slope grouping (< 5%, 5 - 15 .....).
b) How do you want to have it hatched, pattern names and so on.
I usually do this in following way.
Somewhere aside I have hatched tiles with appropriate hatch pattern, in scale color and destination layer.
After creating dummy hatch I use matchprop tool and thats it.
My last code that must work
(setq dy nil ) (defun c:hh2 ( / equalPoints lwpolypoints *error* old pts p1 p2 p3 p4 bound oldch dd dh dv gr grstr slope ) (defun equalPoints ( pt1 pt2 ) (apply 'and (mapcar '= pt1 pt2))) (defun lwpolypoints ( e / ent elev ptlist closed pt pt1 ) (setq ent (entget e) elev (cdr (assoc 38 ent)) closed (cdr (assoc 70 ent)) pt1 (cdr (assoc 10 ent)) ) (while (setq ent (member (assoc 10 ent) ent) pt (car ent) ent (cdr ent)) (setq p (list (cadr pt) (caddr pt) elev)) (if (atom ptlist) (setq ptlist (cons p ptlist))) (if (and (listp ptlist) (not (equalPoints (car ptlist) p))) (setq ptlist (cons p ptlist))) ) (if (and (= 1 (logand closed 1)) (not (equalPoints (car ptlist) pt1))) (setq ptlist (cons pt1 ptlist))) (reverse ptlist) ) (defun *error* ()(setq chmode oldch) (princ)) (setq oldch (getvar "cmdecho")) (setvar "cmdecho" 0) (if (not dy) (setq dy (getreal "\n Vertical offset for hatch area >"))) (setq pts (lwpolypoints (car (entsel "\nSelect slope lwpolyline >")))) (repeat (- (length pts) 1) (setq p1 (car pts) p2 (cadr pts) pts (cdr pts) p3 (mapcar '- p2 (list 0 dy)) p4 (mapcar '- p1 (list 0 dy)) dd (mapcar '- p2 p1) dv (* 0.01 (cadr dd)) dh (* 0.1 (car dd)) gr (* 100.0 (/ dv dh)) grstr (strcat (rtos gr 2 2) "%") ang (angle p1 p2) bound (entmakex (apply 'append (cons (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) '(67 . 0) '(70 . 1) ) (mapcar 'list (mapcar '(lambda ( a ) (cons 10 a)) (list p1 p2 p3 p4))) ) ) ) ) (command "_.hatch" "p" "s" "s" (entlast) "") (command "_.draworder" (entlast) "" "b") (entmakex (list '(0 . "TEXT") (cons 10 (mapcar '* (mapcar '+ p1 p2) (list 0.5 0.5))) '(40 . 15) (cons 50 ang) (cons 1 grstr) ) ) (entdel bound) ) (setvar "cmdecho" oldch) (princ) )
Miljenko Hatlak
@hak_vz wrote:
1) @Anonymous - "to show that difference by adding hatch (similar to the highlighter below) that changes hatch consistency (or layer)"
I guess she wants to use hatch pattern with different scale factor ("gravel"). Then using solid doesn't work
2) Horizontal and vertical scale are different
3) One may use hatch with different color, instead of layers.
....
1) As much a fault in yours as mine, using the Solid Hatch pattern. [Also, the (command) that does the Hatching is done differently in your different routines, and in some returns an unknown-pattern-name message for me in Acad2019 -- the proper sequence varies with version, as also differs if a hyphen is used before the command name.] So @Anonymous , is something like your image acceptable, with solid colors, or does it need to be a non-Solid Hatch pattern at different scales, or maybe different Hatch patterns?
2) Yes, but there are determinable slopes of exaggerated-vertical line segments that represent the break points between low and medium and steep slopes in reality -- it's just a matter of determining what the result of the division is for each break point, accounting for the exaggeration, and putting those as instructed in place of my arbitrary 0.25 and 0.5 [and more if they have more than 3 slope categories]. Those would need to be different for different vertical exaggerations, so if they use different ones, they would need to have different routines for each, or a prompt for the vertical exaggeration could be added, and the breakdown calculated from that. In any case, the range of slope within each category is needed to really finalize something.
IF it really needs to be a Hatch pattern at different scales, here's a way to do that, taking advantage of the fact that Hatch can let you draw the boundary directly, rather than have a pre-drawn object to pick. This one also puts the pattern at different rotation angles along with the different densities, to help differentiate, and that's one reason I chose not to use a pattern such as Gravel, where the rotation difference wouldn't be apparent. Again, it requires selection of a LWPolyline, and doesn't [yet] verify that.
(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))))
); setq
(command "_.hatch" "_user")
(cond ;;; EDIT slope cut-off values and angles/spacings, add categories
((<= slope 0.25) (command "30" 20)); [low density for shallow slope]
((<= slope 0.5) (command "45" 15)); [medium density for medium slope]
((command "60" 10)); [high density for steep slope]
); cond
(command "_yes" "" "_no"
;; to double-hatch, 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"
"" ; Accept
); command
); repeat
(princ)
); defun
The same similar situation I set up before yields this:
You can change the spacing numbers and/or rotations to make the differences more obvious, and of course appropriate spacing numbers will depend on your typical drawing scale and drawing unit. [If you want a specific pattern, don't just change the pattern name, because the answers to prompts here are specific to the User-defined pattern.]
You could also use a different pattern for each slope category. You would need to put the pattern name into the (command) functions inside each slope (cond)ition, rather than in the one before the (cond)itions, and of course answer other prompts appropriately.
I think your solution is ok, and it needs some final touches.
She uses different horizontal and vertical scale and that has to be considered.
I took hatch command as a compromise because creating hatch and changing its properties programmatically may sometime create unwanted results. Unfortunately, command hatch has different parameters in different versions.
As I stated before, you may finish this topic since I know you' ll create best solution for @Anonymous .
PS
I would try to achieve equal width of all hatch segments perpendicular to poly segment, and create joining to next segment as an arch. In high slopes hatch area doesn't look natural. But if to complicated, this is also ok.
Miljenko Hatlak
So here is an example of what I kind of want. The slope variation cut off is sort; 0-4.99% = light (sand), 5-9.99% = medium (smaller scale gravel), 10% or greater = large (larger scale gravel)
@Anonymous wrote:
So here is an example of what I kind of want. The slope variation cut off is sort; 0-4.99% = light (sand), 5-9.99% = medium (smaller scale gravel), 10% or greater = large (larger scale gravel)
And what is the vertical exaggeration in the profiles?
