Search the Community

I've wrote a function to select hatches based on their layer layColor patName patScale What I'm missing is getting the DXF data on ssget for the vla-get-backgroundcolor As I'm not sure if this is exposed to the DXF. Any help would be appreciated. Thanks. ; ; Select hatches on same layer & pattern by 3dwannab ; ; v0.1 - 16.03.2017 ; Usage: Select hatch to select other hatches on similar bkgCol color layer patName patScale (defun c:TEST nil (c:QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor)) (defun c:QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor ( / ss ssdata layer layColor patName patScale bkgCol) (while (not (and (setq ss (car (entsel "\nSelect Hatch to get same Hatch entities as:\nlayer layColor patName patScale bkgCol: ")) ssdata (if ss (entget ss)) ) (= (cdr (assoc 0 ssdata)) "HATCH") (sssetfirst nil) (setq ss (vlax-ename->vla-object ss)) (progn (setq bkgCol (vla-get-backgroundcolor ss) layColor (vla-get-color ss) layer (vla-get-Layer ss) patName (vla-get-PatternName ss) patScale (vla-get-PatternScale ss) ) (setq ss (ssget "X" (list (cons 8 layer) '(0 . "HATCH") (cons 2 patName) (cons 62 layColor) (cons 41 patScale) (cons 410 (getvar 'ctab))))) (princ (strcat "\n >>> " (itoa (setq len (sslength ss))) (if (> len 1) " items" " item") " selected <<< ")) (sssetfirst nil ss)(princ) ) ) ) (prompt "\n >>> Nothing selected, or please select a hatch ! <<< ") ) (princ) ) (vl-load-com) (princ "\n:: QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor.lsp | Version 1.0 | by 3dwannab ::") (princ "\n:: Type \"QS_HATCH_SAME_Layer_PatternName_PatternScale_Color_&_BkgColor\" OR \"TEST\" to Invoke ::") (princ)

Hi all, I am in desperate need for lsp that create multiple hatches for multiple closed different colored polylines so that the hatch would match the same COLOR (RGB not index) and ELEVATION of that polyline, I have found one that matches the hatch's elevation to the polyline but no luck with the color? Please help, I am desperate! Thanks in advance!

I've been working on a project where I have used various hatch patterns to indicate sidewalks, bicycle paths and water. It shows up in my AutoCAD as shown on the screenshot, but the patterns are not appearing in either the print previews or the pdf's. Only one hatch pattern ends up showing up in the PDF, the diagonal lines underneath the street. I've tried changing "HPmaxlines" to 1000000, tried various plotters of AutoCAD and Adobe, reset AutoCAD settings. Nothing seems to work and I cannot understand why, as it shows up right there when I'm working on the file. Could anybody please take a look at the attached files and perhaps notice anything I've been missing? It would be much appreciated. The used Hatch patterns are ANSI31 scale 1 in gray (working) ANSI31 scale 1 in white (Not working), AR-HBONE scale 0.01 white (Not working), NET3 scale 1 in white (Not working) and a custom downloaded one which I applied in a second version. The issues were already there before I used the downloaded hatch pattern. Doorsnede Laan op Zuid Eindopdracht poging 1.pdf Doorsnede Laan op Zuid Eindopdracht 2 v1.dwg

With the code below this sometimes works and other times not. The test point command places points on top of each other when it shouldn't. I can't figure out why. See lines 126-155 of the code below. It's the offset section of the code that I can't get working. I've tried to see if a VLA method could work but the help found here is a bit beyond my understanding. See the attached sample drawing. I want to offset each hatch by an x,y value. Similar thread here. ;;------------ ------=={ HH_Origin_Location.lsp }==---------------------;; ;; Author: 3dwannab, 2023 ;;----------------------------------------------------------------------;; ;; Version 0.1 - 2017.03.18 - First release. ;; Version 0.2 - 2018.04.11 - Added OSNAPHATCH to 1 to allow picking hatch snap points. ;; Added a pickAll option to affect all selected Hatches, not just one at a time. ;; initget 1) added to force point pickage. ;; Version 0.2 - 2023.09.25 - Added offset option. ;;----------------------------------------------------------------------;; ;; Hatch Location Options: ;; BottomLeft/BottomRight/TopRight/TopLeft/Center/Pickone/pickAll/Offset ;; pickAll affects all selected and asks user to pick one point. ;; Pickone allows the user to select hatch then point. This will go in a loop, ESC to exit. ;;----------------------------------------------------------------------;; (defun c:HOL nil (c:HH_Origin_Location)) (defun c:HH_Origin_Location (/ *error* acDoc ans bdata ent i offsetPt pt ptHatchOriginX ptHatchOriginXYNew ptHatchOriginY ss var_cmdecho var_nomutt var_osnaphatch) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'CMDECHO var_cmdecho) (setvar 'NOMUTT var_nomutt) (setvar 'OSNAPHATCH var_osnaphatch) (princ) ) (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) (setq var_cmdecho (getvar "CMDECHO")) (setq var_nomutt (getvar "NOMUTT")) (setq var_osnaphatch (getvar "OSNAPHATCH")) (setvar 'cmdecho 0) (setvar 'nomutt 1) (setvar 'osnaphatch 1) (initget "bottomLeft bottomRight toprIght toplEft Center Pickone pickAll Offset") (setq ans (getkword "\nChoose hatch location: [bottom Left/bottom Right/top rIght/top lEft/Center/Pick one/pick All/Offset] <pickAll>: ")) (if (not ans) (setq ans "pickAll")) (princ (strcat "\n" ans " option choosen.\n")) (cond ((= "pickAll" ans) (initget 1) (setq pt (getpoint "\n\t\tNew hatch origin : ")) ) ((= "Offset" ans) (initget 1) (setq offsetPt (getpoint "\nOffset by (x,y) : ")) ) ) (progn (cond ((= "Pickone" ans) (sssetfirst) (setvar 'osmode 1023) (while (not (progn (and (setq ent (car (entsel "\nSelect hatch (ESC to exit): ")) bdata (if ent (entget ent)) ) (= (cdr (assoc 0 bdata)) "HATCH") (progn (initget 1) (setq pt (getpoint "\nNew hatch origin: ")) (command "_.HatchEdit" ent "_O" "_S" pt "_Y") ) ) ) ) (cond ((/= (cdr (assoc 0 bdata)) "HATCH") (princ "\n: -------------------------\n\t\t*** Nothing selected, or it is not a Hatch! ***\n") ) ) ) ) ) (cond ((/= "Pickone" ans) (if (setq ss (ssget "_:L" '((0 . "HATCH")))) (repeat (setq i (sslength ss)) (setq ent (ssname ss (setq i (1- i)))) (cond ((= "bottomLeft" ans) (command-s "_.HatchEdit" ent "_O" "_D" "_L" "_Y") (princ) ) ((= "bottomRight" ans) (command-s "_.HatchEdit" ent "_O" "_D" "_R" "_Y") (princ) ) ((= "toprIght" ans) (command-s "_.HatchEdit" ent "_O" "_D" "_I" "_Y") (princ) ) ((= "toplEft" ans) (command-s "_.HatchEdit" ent "_O" "_D" "_E" "_Y") (princ) ) ((= "Center" ans) (command-s "_.HatchEdit" ent "_O" "_D" "_C" "_Y") (princ) ) ((= "pickAll" ans) (command-s "_.HatchEdit" ent "_O" "_S" pt "_Y") (princ) ) ((= "Offset" ans) ; (if (cdr (assoc 44 bdata)) (setq bdata (entget ent)) (setq ptHatchOriginX (cdr (assoc 43 bdata))) (setq ptHatchOriginY (cdr (assoc 44 bdata))) (setq ptHatchOriginXYNew (mapcar '+ offsetPt (list ptHatchOriginX ptHatchOriginY 0))) ; Here I've tried the VLA approach but not sure how to get this to work. ; (setq origin (vla-get-origin o)) ; (princ origin) (princ "\n") (princ "Testing lines...") (princ "\n") (princ ptHatchOriginX) (princ "\n") (princ ptHatchOriginY) (princ "\n") (princ (list ptHatchOriginX ptHatchOriginY)) (princ "\n") (princ ptHatchOriginXYNew) (princ "\n") (princ offsetPt) (command-s "_.HatchEdit" ent "_O" "_S" ptHatchOriginXYNew "_Y") (princ) (command "point" (list ptHatchOriginX ptHatchOriginY 0)) (command "point" ptHatchOriginXYNew) ; ) ) ) ) ) ) ) T ) (princ (strcat "\n\t\t<<< " (itoa (sslength ss)) (if (> (sslength ss) 1) " hatches" " hatch") " changed using " ans " option >>>\n")) (*error* nil) (princ) ) (vl-load-com) (princ (strcat "\nHatch_Origin_Location.lsp | Version 0.2 | \\U+00A9 3dwannab " (menucmd "m=$(edtime,0,yyyy)") "" "\nType \"HOL\" or \"HH_Origin_Location\" to Run." ) ) (princ) ; (c:HH_Origin_Location) ;; Unblock for testing How do I offset each of these hatches.dwg

Hello! I often need to count areas with hatches, using the cumulative area property. And many times, we get bad hatches without area, needing to painstakingly go one by one finding the bad hatch to fix it, sometimes repeating for multiple hatches I tried to find a LISP routine for that without sucess, so i made my own and i'd like to share It loops over the selected hatches, accumulating the bad ones on an empty selection set, highlighting it afterwards. The only little thing bothering me is the (sssetfirst nil serr) function, that highlights the set, sometimes it need an extra click on the screen to show the grips, i tried putting a (command "_REGEN") and (princ) after, without much sucess. I hope it's useful! findBadHatches.lsp

Autolisp to hatch between two plines with different layers (layer1 and layer2 for example). When layer1 is above hatch the area in red, and when layer2 is above hatch in green. Actually I need this to calculate the area of cutt and fill in road cross sections

hello all;I'm using the code bellow, but i need to click on almost 2000 road cross sections one by one, indeed that is time consuming. it would be more general if the code can select all green lines at ones and then the red lines. mean that, if there be 2000 road cross sections for example; the code can select all cross sections and report a cut and fill file separately for each section (the same as AreaLabelV1-9.lsp of Mr.Lee Mac does)appreciate if anyone can help metnx ;;; Cut & Fill by ymg ; ;;; ; (defun c:cf (/ ** *acdoc* a are b bnd c cutcol d dir dl1 dl2 e fillcol hcol intl len1 len2 p p0 p1 p2 pm pol1 pol2 sp1 sp2 spe ss1 ss2 totcut totfill txt txtlayer varl) (vl-load-com) (defun *error* (msg) (mapcar 'eval varl) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*"))) (princ (strcat "\nError: " msg)) ) (and *acdoc* (vla-endundomark *acdoc*)) (princ) ) (setq varl '("OSMODE" "CMDECHO" "DIMZIN" "PEDITACCEPT") varl (mapcar (function (lambda (a) (list 'setvar a (getvar a)))) varl) ) (or *acdoc* (setq *acdoc* (vla-get-activedocument (vlax-get-acad-object)))) (vla-startundomark *acdoc*) (setvar 'CMDECHO 0) (setvar 'DIMZIN 0) (setvar 'OSMODE 0) (setq cutcol 1 fillcol 3 ; Cut is Red, Fill is Green ; totcut 0 totfill 0 ; Total Cut and Total Fill ; txtlayer "Text" ; Name of Layer for Cut and Fill Values ; ) (while (not (setq ** (princ "\nSelect Reference Polyline:") ss1 (ssget "_+.:L:S" '((0 . "LWPOLYLINE"))) ) ) (princ "\nYou Must Select a Polyline:") ) (while (not (setq ** (princ "\nSelect Proposed Polyline:") ss2 (ssget "_+.:L:S" '((0 . "LWPOLYLINE"))) ) ) (princ "\nYou Must Select a Polyline:") ) (setq pol1 (ssname ss1 0) len1 (vlax-curve-getDistAtParam pol1 (vlax-curve-getEndParam pol1)) pol2 (ssname ss2 0) len2 (vlax-curve-getDistAtParam pol2 (vlax-curve-getEndParam pol2)) sp1 (vlax-curve-getstartpoint pol1) spe (vlax-curve-getendpoint pol1) sp2 (if (vlax-curve-isClosed pol2) (setq lst2 (listpol pol2) disl (mapcar '(lambda (a) (distance sp1 a)) lst2) ** (plineorg pol2 (nth (vl-position (apply 'min disl) disl) lst2)) ) (vlax-curve-getstartpoint pol2) ) dir (if (< (/ pi 2) (angle sp1 spe) (/ (* 3 pi) 2)) -1 1) ) ; Getting all the intersections between poly. ; (setq intl (intersections pol1 pol2)) (if (> (length intl) 1) (progn ; Computing distance of intersections on each polyline ; (setq dl1 (mapcar '(lambda (a) (getdistoncurve pol1 a)) intl) dl2 (mapcar '(lambda (a) (getdistoncurve pol2 a)) intl) ) ; If both polyline are closed add first Intersection to end of list ; ; We also add a distance to each distances list ; (if (and (vlax-curve-isClosed pol1) (vlax-curve-isClosed pol2)) (setq dl1 (append dl1 (list (+ (car dl1) len1))) dl2 (append dl2 (list (+ (car dl2) len2))) intl (append intl (list (car intl))) dir (if (iscw_p (listpol pol1)) -1 1) ) ) ; Finding points at mid-distance between intersections on each polyline ; ; Calculating midpoint between mid-distance points to get an internal point; ; Creating a list of all these points plus the intersection points ; (setq pm (mapcar '(lambda (a b c d e) (list (midpoint (setq p1 (getptoncurve pol1 (rem (* (+ a b) 0.5) len1))) (setq p2 (getptoncurve pol2 (rem (* (+ c d) 0.5) len2))) ) p1 p2 e ) ) dl1 (cdr dl1) dl2 (cdr dl2) intl ) ) (foreach i pm (setq p (car i) ; Midpoint between p1 p2 ; p0 (cadddr i) ; Intersection Point ; p1 (cadr i) ; Midpoint of Intersections on Reference Polyline ; p2 (caddr i) ; Midpoint of Intersections on Proposed Polyline ; ) (if (> (abs (onside p2 p0 p1)) 1e-3) ; Not Colinear ; (progn (vl-cmdf "._-BOUNDARY" p "") (setq are (vla-get-area (vlax-ename->vla-object (entlast))) bnd (entlast) ) (if (minusp (* (onside p2 p0 p1) dir)) (setq totfill (+ totfill are) hcol fillcol) (setq totcut (+ totcut are) hcol cutcol) ) (vl-cmdf "._-HATCH" "_CO" hcol "." "_P" "SOLID" "_S" bnd "" "") (entdel bnd) ) ) ) (setq p (cadr (grread nil 13 0)) txt (strcat "{\\C3;Fill: " (rtos totfill 2 2) " m2\\P\\C1;Cut: " (rtos totcut 2 2) " m2}") ) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 8 txtlayer) (cons 100 "AcDbMText") (cons 10 p) (cons 40 3.0) (cons 1 txt) ) ) (command "_MOVE" (entlast) "" p pause) ) (Alert "Not Enough Intersections To Process !") ) (*error* nil) ) (princ "\nCalculates Cut & Fill Between Two Intersecting Polylines") (princ "\nCF to start...") (defun midpoint (p1 p2) (mapcar '(lambda (a b) (* (+ a b) 0.5)) p1 p2) ) ; onside by ymg ; ; Negative return, point is on left of v1->v2 ; ; Positive return, point is on right of v1->v2 ; ; 0 return, point is smack on the vector. ; ; ; (defun onside (p v1 v2 / x y) (setq x (car p) y (cadr p)) (- (* (- (cadr v1) y) (- (car v2) x)) (* (- (car v1) x) (- (cadr v2) y))) ) ; ; ; Is Polyline Clockwise by LeeMac ; ; ; ; Argument: l, Point List ; ; Returns: t, Polyline is ClockWise ; ; nil, Polyline is CounterClockWise ; ; ; (defun iscw_p (l) (if (equal (car l) (last l) 1e-8) (setq l (cdr l))) (minusp (apply '+ (mapcar (function (lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))) ) l (cons (last l) l) ) ) ) ) ;; ; ;; Return list of intersection(s) between two VLA-Object or two ENAME ; ;; obj1 - first VLA-Object ; ;; obj2 - second VLA-Object ; ;; mode - intersection mode (acExtendNone acExtendThisEntity ; ;; acExtendOtherEntity acExtendBoth) ; ;; Requires triplet ; ;; ; (defun Intersections (obj1 obj2) (or (= (type obj1) 'VLA-OBJECT) (setq obj1 (vlax-ename->vla-object obj1))) (or (= (type obj2) 'VLA-OBJECT) (setq obj2 (vlax-ename->vla-object obj2))) (triplet (vlax-invoke obj1 'intersectwith obj2 acExtendNone)) ) ;; ; ;; triplet, Separates a list into triplets of items. ; ;; ; (defun triplet (l) (if l (cons (list (car l) (cadr l) (caddr l))(triplet (cdddr l)))) ) (defun getdistoncurve (e p) (vlax-curve-getDistatParam e (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e p) ) ) ) (defun getptoncurve (e d) (vlax-curve-getpointatparam e (vlax-curve-getparamatdist e d)) ) ;; ; ;; listpol by ymg (Simplified a Routine by Gile Chanteau ; ;; ; ;; Parameter: en, Entity Name or Object Name of Any Type of Polyline ; ;; ; ;; Returns: List of Points in Current UCS ; ;; ; ;; Notes: On Closed Polyline the Last Vertex is Same as First) ; ;; ; (defun listpol (en / i l) (repeat (setq i (fix (1+ (vlax-curve-getEndParam en)))) (setq l (cons (trans (vlax-curve-getPointAtParam en (setq i (1- i))) 0 1) l)) ) ) ;; plineorg by (gile) (Modified into a function by ymg) ; ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ ; ;; change-polyline-start-point/td-p/2154331 ; ;; ; ;; Function to modify origin of a closed polyline ; ;; ; ;; Arguments: ; ;; en : Ename or VLA-Object of a Closed Polyline. ; ;; pt : Point ; ;; ; ;; Returns: Point of Origin if successful, else nil. ; ;; ; (defun plineorg (en pt / blst d1 d2 d3 n norm obj pa plst) (if (= (type en) 'ENAME) (setq obj (vlax-ename->vla-object en)) (setq obj en en (vlax-vla-object->ename obj)) ) ;; bulgratio by (gile) ; ;; Returns a bulge which is proportional to a reference ; ;; Arguments : ; ;; b : the reference bulge ; ;; k : the ratio (between angles or arcs length) ; (defun bulgratio (b k / a) (setq a (atan b)) (/ (sin (* k a)) (cos (* k a))) ) ;; Sublist by (gile) ; ;; Returns a sublist similar to substr function. ; ;; lst : List from which sublist is to be extracted ; ;; idx : Index of Item at Start of sublist ; ;; len : Length of sublist or nil to return all items. ; (defun sublist (lst n len / rtn) (if (or (not len) (< (- (length lst) n) len)) (setq len (- (length lst) n)) ) (setq n (+ n len)) (repeat len (setq rtn (cons (nth (setq n (1- n)) lst) rtn)) ) ) (if (and (= (vla-get-closed obj) :vlax-true) (= (vla-get-objectname obj) "AcDbPolyline") ) (progn (setq plst (vlax-get obj 'coordinates) norm (vlax-get obj 'normal) pt (vlax-curve-getClosestPointTo en (trans pt 1 0)) pa (vlax-curve-getparamatpoint obj pt) n (/ (length plst) 2) ) (repeat n (setq blst (cons (vla-getbulge obj (setq n (1- n))) blst)) ) (if (= pa (fix pa)) (setq n (fix pa) plst (append (sublist plst (* 2 n) nil) (sublist plst 0 (* 2 n)) ) blst (append (sublist blst n nil) (sublist blst 0 n)) ) (setq n (1+ (fix pa)) d3 (vlax-curve-getdistatparam en n) d2 (- d3 (vlax-curve-getdistatpoint en pt)) d3 (- d3 (vlax-curve-getdistatparam en (1- n))) d1 (- d3 d2) pt (trans pt 0 (vlax-get obj 'normal)) plst (append (list (car pt) (cadr pt)) (sublist plst (* 2 n) nil) (sublist plst 0 (* 2 n)) ) blst (append (list (bulgratio (nth (1- n) blst) (/ d2 d3))) (sublist blst n nil) (sublist blst 0 (1- n)) (list (bulgratio (nth (1- n) blst) (/ d1 d3))) ) ) ) (vlax-put obj 'coordinates plst) (repeat (setq n (length blst)) (vla-setbulge obj (setq n (1- n)) (nth n blst)) ) (trans pt 0 1) ) nil ) )

Hi all - I've spent so many accumulated hours searching for a basic Wood Flooring hatch. Plank, random or at least 1/3 offset (no sunning bond/1/2 offset) - you know, how pretty much all wood flooring ever done looks installed. I'm so surprised there's not an abundance of this pattern? Or at least 1 that comes with my AutoCAD LT version. Does anyone have one they could share or a reputable source to purchase from? Please see image below, something along the lines of this. Of course there are images and other forums all over google, but as soon as you click them the sites don't exist any more, or the post from 2005 no longer has the attachment (which is how I found this website). Any help would be appreciated.

I want to make this design, as you can see in the image below. But, as you can see in the video I have some problems: First, I dont know why dont recognise the command "S"(Select object) in the command Hatch (watch it in the video), and then I have to make a enter, because without this wouldnt keep running(I dont understand also why). Second, I just codified that a single hatch circle would add the color 171. But, (as you can see in the video) all circles are painted in color 171, less the circle I seted it. (circle 1) Thanks if someone can help me. I am stucked. WhatsApp Video 2020-02-26 at 18.21.44.mp4 WhatsApp Video 2020-02-26 at 18.21.44.mp4

When i hatch a drawing like the one below, it occurs "boudary definiton error". But the drawing is defined by a single 2d boundary poly line. And I uploaded the drawing in the appendix. I'll be very appriciated if someone can give some help! error_hatch.dwg

Using AutoCAD 2016, when I pick a point inside an area to HATCH, the frames of images attached to the drawing create boundaries for the hatch, even when the images are not visible and the image frame variable is turned off. How can I avoid this? Thanks.

I remember coming across a function that would highlight or mark a specified drawing area. Kind of like what you get when the hatch command detects a gap in the boundry selected. Small red circles that remain until a regen or redraw. Did I imagine it or does such a function exist? I know it can be replicated by some sort of entmake or grvecs/grdraw combo... but like I mentioned I thought I remember seeing that exact function somewhere. Anyway thanks for your time.

I use the custom palettes for Hatch presets. Only trouble is that it doesn't have the option to have a background Hatch colour. Is there any workaround for this?

Hi, Ever annoyed about having to open the hatch dialog to get inherent props from an existing hatch and then AutoCAD seems to think it fine for the hatch to be non associative too!!! Here is a script I wrote and wanted to share. It simply uses the addselected command to hatch your selected objects even though they might be non associative, this will ensure associative hatches for life........ It works with every hatch type you can throw at it (Anno and backgrounds too) while retaining ALL the exact same properties. I need to get it so it'll add the annotation scales but the script will set the flag for it if the source hatch is annotative. PLEASE LET ME NOW WHAT YOU THINK OR DON'T THINK ABOUT IT. ;; FUNCTION SYNTAX Hatch_Off or HOFF ;; ABOUT / NOTES ;; ABOUT / NOTES ;; - Hatches using ADDSELECTED command method, no more Hatch UI (EVER) to pick an existing HATCH. ;; - Automatically changes the HPASSOC variable to 1 then sets it back, ;; upon error or exiting the command. ;; - First pick the HATCH you want then, select your LWPOLYLINES, CIRCLES or ELLIPSES to HATCH. ;; This routine is made to only select closed LWPOLYLINES. An easy way to identify them. ;; You can run a script called PSIMPLE to fix you entire drawing in one go. See here >>> http://www.theswamp.org/index.php?topic=19865.msg244786#msg244786 ;; - If you want un-associative HATCH for some reason change '(setvar 'hpassoc 1)' to '0'. ;; - Automatically selects the newly created HATCH/es. ;; - Sends draworder of HATCH behind selected objects. ;; FULL CODE ;; --------------------------=={ Hatch_Off }==---------------------------- ;; ----------------------------------------------------------------------- ;; AUTHOR & ADDITIONAL CODE ;; Author: 3dwannab, Copyright © 2018. ;; Error functions: LeeMac Help pages. www.lee-mac.com. ;; ABOUT / NOTES ;; - Hatches using ADDSELECTED command method, no more Hatch UI (EVER) to pick an existing HATCH. ;; - Automatically changes the HPASSOC variable to 1 then sets it back, ;; upon error or exiting the command. ;; - First pick the HATCH you want then, select your LWPOLYLINES, CIRCLES or ELLIPSES to HATCH. ;; This routine is made to only select closed LWPOLYLINES. An easy way to identify them. ;; You can run a script called PSIMPLE to fix you entire drawing in one go. See here >>> http://www.theswamp.org/index.php?topic=19865.msg244786#msg244786 ;; - If you want un-associative HATCH for some reason change '(setvar 'hpassoc 1)' to '0'. ;; - Automatically selects the newly created HATCH/es. ;; - Sends draworder of HATCH behind selected objects. ;; FUNCTION SYNTAX ;; Short-cut HOFF ;; Long-cut Hatch_Off ;; VERSION DATE INFO ;; Version 1.0 26-07-2018 Initial release. ;; Version 1.01 27-07-2018 var_hatch_bkgcolouradded to set the hatch background colour to none so that the addselected command doesn't use that instead of the original one picked. ;; TO DO LIST ;; Change the polylines to the current boundary attributes of selected hatch boundary. ;; Put all of the annotative scales to the newly created hatch. ;; If a hatch exists on the selected polylines then delete them and hatch with new. ;; Check if it works in different UCS modes. (NOT SURE) ;; ----------------------------------------------------------------------- ;; ---------------------=={ Hatch_Off START }==--------------------------- (defun c:---LOAD_HATCH_OFF (/) (LOAD "Hatch_Off") (c:HOFF)) (defun c:HOFF () (c:Hatch_Off)) (defun c:Hatch_Off ( / *error* ent_1 ent_1_vla ent_1_data sel_me ss_1 tmp var_cmde var_hatch_ass var_hatch_bkgcolour var_os ) (setq *error* LM:error) (LM:startundo) (setq var_cmde (getvar "cmdecho")) (setq var_hatch_anno (getvar "hpannotative")) (setq var_hatch_ass (getvar "hpassoc")) (setq var_hatch_bkgcolour (getvar "hpbackgroundcolor")) (setq var_os (getvar "osmode")) (setvar 'cmdecho 0) (setvar 'osmode 0) (setvar 'hpbackgroundcolor ".") (while (not (and (setq ent_1 (car (entsel "\nPlease select a HATCH to copy.\n: ------------------------------ :\n\nThen select any closed LWPOLYLINE's, CIRCLE's or ELLIPSE's.\n")) ent_1_data (if ent_1 (entget ent_1)) ) (= (cdr (assoc 0 ent_1_data)) "HATCH") (sssetfirst nil) (setq ent_1_vla (vlax-ename->vla-object ent_1)) (progn (setq ent_last (entlast) sel_me (ssadd) ) (while (setq tmp (entnext ent_last)) (setq ent_last tmp)) (princ "\nNow select your objects to be HOFF'ified !\n") (setq ss_1 (ssget '( (-4 . "<OR") (-4 . "<AND") (0 . "LWPOLYLINE") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "CIRCLE,ELLIPSE") (-4 . "AND>") (-4 . "OR>") ))) (if (IsAnno-p (vlax-ename->vla-object ent_1)) (setvar 'hpannotative 1) ) (setvar 'hpassoc 1) (if ss_1 (progn (command "_.addselected" "_non" ent_1 "_S" ss_1 "" "" ) (command "._draworder" (entlast) "" "_U" ss_1 "") (while (setq ent_last (entnext ent_last)) (ssadd ent_last sel_me) ) (sssetfirst nil sel_me) (princ (strcat "\nYou've been HOFF'd with < "(itoa (sslength ss_1)) (if (> (sslength ss_1) 1) " > objects" " object") " hatched.\n")) ) ) )(princ) ) ) ) (*error* nil)(princ) )(princ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- (vl-load-com) (defun IsAnno-p (ent / exd ano) (vl-load-com) (and (eq (vla-get-HasExtensionDictionary ent) :vlax-true) (setq exd (vla-GetExtensionDictionary ent) exd (vla-item exd "AcDbContextDataManager") ano (vla-item exd "ACDB_ANNOTATIONSCALES") ) (not (zerop (vla-get-Count ano))) ) ) (defun LM:error (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'cmdecho var_cmde) (setvar 'hpassoc var_hatch_ass) (setvar 'osmode var_os) (setvar 'hpannotative var_hatch_anno) (setvar 'hpbackgroundcolor var_hatch_bkgcolour) (princ (strcat "\nNo HOFF for you today !\n")) ) (princ) (defun LM:startundo () (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) ) (princ) ;; ----------------------------------------------------------------------- ;; -----------------------=={ Functions END }==-- ------------------------ (princ "\nHatch_Off loaded | Version 1.0 | by 3dwannab.\n") (princ "\nType \"Hatch_Off\" OR \"HOFF\" to run.\n") (princ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Hatch_Off END }==---------------------------- ;; EOL

Hi all, Here's a LISP that I'm having a problem with. Everything's working OK apart from getting the angle of the HATCH working. It doesn't work until I run it through a -hatchedit command. Is this a UCS problem? Drawing: Hatch Rotation Selection Issue.dwg LISP: (defun c:QSHLPASCB nil (c:QSHATCH_SAME_Layer_PatName_Rotation_PatScale_Color&BkgColor)) (defun c:QSHATCH_SAME_Layer_PatName_Rotation_PatScale_Color&BkgColor (/ bkgcol ent_1 laycolor layer nss patangle patname patscale ss_1 ssdata ) (while (not (and (setq ent_1 (car (entsel "\nSelect Hatch to get same Hatch entities as:\n\n- LAYER\n- PATTERN NAME\n- PATTERN ANGLE\n- PATTERN SCALE\n- COLOUR\n- BACKGROUND COLOUR\n-------------------------------------------------------------")) ssdata (if ent_1 (entget ent_1)) ) (= (cdr (assoc 0 ssdata)) "HATCH") (sssetfirst nil) (setq ss_1 (vlax-ename->vla-object ent_1)) (progn (setq bkgcol (vla-get-backgroundcolor ss_1) bkgcol (vla-get-ColorIndex (vla-get-BackgroundColor ss_1)) laycolor (vla-get-color ss_1) layer (vla-get-Layer ss_1) patname (vla-get-PatternName ss_1) patangle (vla-get-PatternAngle ss_1) patscale (vla-get-PatternScale ss_1) ss_1 (ssget "X" (vl-remove 'nil (list (cons 8 layer) '(0 . "HATCH") (cons 2 patname) (cons 52 patangle) (cons 62 laycolor) (cons 410 (getvar 'ctab)) (if (/= "SOLID" patname) (cons 41 patscale) ) ) ) ) nss (ssadd) ) (repeat (setq i (sslength ss_1)) (and (setq e (ssname ss_1 (setq i (1- i)))) (= bkgcol (vla-get-ColorIndex (vla-get-BackgroundColor (vlax-ename->vla-object e)))) (ssadd e nss) ) ) (princ (strcat "\n: ------------------------------\n <<< "(itoa (sslength ss_1)) (if (> (sslength ss_1) 1) " >>> similar HATCHES" " >>> similar HATCH") " selected.\n: ------------------------------\n")) (sssetfirst nil nss) ) ) ) ) (princ) )

Hi Everyone, I'm currently sinking in opened links on finding a vertical wood grain hatch pattern. I finally found a hatch pattern close to what i have, but now it needs to be rotated by abut 27degrees. Could anyone please help with this. Attached is a sample of the Pattern legno4 - Kopie.pat.txt

Hello, I'm looking for some help in the task of making my plans less boring. I'd like to use some non - uniform hatches to obtain something similar to the attached image. https://images.adsttc.com/media/images/595d/1743/b22e/38d8/8b00/0036/slideshow/SAN_-_siteplan_-_rooftop.jpg?1499273017 The building probably has a gradient hatch, while the lawn, and the concrete plaza, what hatch did they use for it? Thanks in advance.

Greetings all, I've just joined the CADTutor site as I'm getting back into AutoCAD (using the 2018 version) and have very little prior experience (previously used AutoCAD 2008 / 2009 for basic balustrade drawings many years ago). I'm trying to become a freelance draftsperson in the Aluminium window and door industry and am currently working on Dynamic blocks. I'm using a hatch pattern on the glass with a gradient of 180 (so it appears lighter in the pocket) and have added several functions including a flip function into the block. Unfortunately when using the flip function the gradient remains unchanged (doesn't flip with the hatch or change the angle to 0) and I can't figure out what I'm doing wrong. I'm using attributes for the extrusion codes / notes so I can mirror the block without any problems but it would just be so much quicker and easier to use the flip function. If anyone can provide some insight it would be much appreciated. Regardos, Scottie.

Hi there, I am working on ACAD 2004. I had an array of hatches beyond the pre-defined provided with the program. For years I have used a few, but great, hatches. My computer finally died. I loaded 2004 on my new machine and am now missing two thirds of the hatches I had. 1. How do I find the other hatches? or are they lost with the old machine? 2. In old drawings I can see the desired hatch. Is there a way to extract the hatch form the old drawings and load into on to my new machine? Thanks, Troy

How can I filter a selection of hatch by gradient name using ssget fonction? The exeample bellow works well for standard hatch name... it does not work for gardient WORK: (setq ss (ssget "_X" (list '(0 . "HATCH")'(2 . "GRASS")))) DONT WORK: (setq ss (ssget "_X" (list '(0 . "HATCH")'(2 . "gradient")))) OR (setq ss (ssget "_X" (list '(0 . "HATCH")'(2 . "gr_spher")))) Could you help me?

Hello, I have taken the following code lines from the formum and tried something to change. My problem is that it does not always work. Unfortunately, I can not see the reason why it often works and often not. This Lisp should: There are many groups of objects in the drawing. The drawing already contains some default hatching. 1) The user selects an existing hatching and then fills different areas belonging to different groups With this hatching. 2) When the user has finished the "_ADDSELECTED" command, the Lisp should add each individual hatch to the group that they have encloses. It works often but not always! Why? Please help. Martin Lisp: ;;----------------------=={ Inside-p }==----------------------;; ;; ;; ;; Predicate function to determine whether a point lies ;; ;; inside a supplied LWPolyline. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac - www.lee-mac.com ;; ;; Using some code by gile (as marked below), thanks gile. ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; pt - 3D WCS point to test ;; ;; ent - LWPolyline Entity against which to test point ;; ;;------------------------------------------------------------;; ;; Returns: T if supplied point lies inside supplied LWPoly ;; ;;------------------------------------------------------------;; (defun LM:Inside-p (pt ent / _GroupByNum lst nrm obj tmp) (defun _GroupByNum (l n / r) (if l (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l) ) r ) ) (_GroupByNum l n) ) ) ) (if (= (type ent) 'VLA-OBJECT) (setq obj ent ent (vlax-vla-object->ename ent) ) (setq obj (vlax-ename->vla-object ent)) ) (setq lst (_GroupByNum (vlax-invoke (setq tmp (vlax-ename->vla-object (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 pt) (cons 11 (trans '(1. 0. 0.) ent 0)) ) ) ) ) 'IntersectWith obj acextendnone ) 3 ) ) (vla-delete tmp) (setq nrm (cdr (assoc 210 (entget ent)))) ;; gile: (and lst (not (vlax-curve-getparamatpoint ent pt)) (= 1 (rem (length (vl-remove-if (function (lambda (p / pa p- p+ p0 s1 s2) (setq pa (vlax-curve-getparamatpoint ent p)) (or (and (equal (fix (+ pa (if (minusp pa) -0.5 0.5 ) ) ) pa 1e-8 ) (setq p- (cond ((setq p- (vlax-curve-getPointatParam ent (- pa 1e- ) ) (trans p- 0 nrm) ) ((trans (vlax-curve-getPointatParam ent (- (vlax-curve-getEndParam ent) 1e- ) 0 nrm ) ) ) ) (setq p+ (cond ((setq p+ (vlax-curve-getPointatParam ent (+ pa 1e- ) ) (trans p+ 0 nrm) ) ((trans (vlax-curve-getPointatParam ent (+ (vlax-curve-getStartParam ent) 1e- ) 0 nrm ) ) ) ) (setq p0 (trans pt 0 nrm)) (<= 0 (* (sin (angle p0 p-)) (sin (angle p0 p+)))) ;; LM Mod ) (and (/= 0. (vla-getBulge obj (fix pa))) (equal '(0. 0.) (cdr (trans (vlax-curve-getFirstDeriv ent pa) 0 nrm) ) 1e-9 ) ) ) ) ) lst ) ) 2 ) ) ) ) (defun c:hatch2group (/ ss i lst pt ent drehwink pt1 as OBJ AWS mypick) (setq mypick (getvar "pickstyle")) (setvar "pickstyle" 0) (setq OBJ (entlast)) (command "_ADDSELECTED" Pause (setq pt1 (getpoint "\nPick Point: ")) ) (while (/= (getvar "CMDACTIVE") 0) (command pause)) (setq AWS (ssadd)) (while (setq OBJ (entnext OBJ)) (ssadd OBJ AWS)) (sssetfirst AWS AWS) (setq as (entlast)) (if (and (setq ss (ssget "_X" '((0 . "LWPOLYLINE")))) (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst)) ) (setq pt pt1) ) ;(if (setq ent (car (vl-member-if (function (lambda (x) (LM:Inside-p (trans pt 1 0) x)) ) lst ) ) ) ;(vla-put-color (vlax-ename->vla-object ent) acRed) ) (princ) (command "_groupedit" ent "H" AWS "") (while (/= (getvar "CMDACTIVE") 0) (command pause)) (setvar "pickstyle" mypick) (princ) ) (princ)

Hello everbody. Thank all for read my thread I want to determine the blue dot coordinates but fail. i hope everybody help me code lisp My code ;;------------------------------=={ 2017 }==-------------------------------;; (prompt "\n=={Created by PHÒNG TKCD - CIENCO625******************************}==") (prompt "\n=={Thanhdattdk@gmail.com******************************}==") ;;---------------------------------------------------------------------------;; (defun c:mm () (princ "\nCh\U+1ECDn c\U+00E1c Hatch c\U+1EA7n t\U+1EA1o l\U+1EA1i Boundary : ") (command "-style" "DIENTICH" "arialbd_0.ttf" "0" "0.9" "0" "n" "n") (setq tnct (ssget (list (cons 0 "HATCH")))) (setq i 0) (setq lmt (sslength tnct)) (while (< i lmt) (setq e (ssname tnct i)) (setq laynd (entget e)) [b][color="blue"](setq td (cdr (assoc 10 laynd)))[/color][/b] ;tao tap rong de tinh dien tinh cho Hatch tao nhieu PL (setq S 0) (setq Q (entlast) AA (ssadd)) (command "-hatchedit" e "B" "P" "") (while (setq Q (entnext Q)) (setq AA (ssadd Q AA)) ) ;tinh dien tich cac phan tu cua group vua tao (setq j 0) (setq dat (sslength AA)) (while (< j dat) (setq doituong (ssname AA j)) (command "area" "o" doituong) (setq Si (getvar "area")) (setq S (+ S Si)) (setq j (+ j 1)) ) (princ S) (princ td) (command ".ERASE" AA "") ;viet text len vi tri hatch (command "text" "ml" td "2.5" "0" S "") (setq i (+ i 1)) );END WHILE (princ))

First of me, Hi to everyone! Glad to be part of this. I am pretty new to this forum so as to AutoCad software, I am GIS maniac. Currently working on some urban plan and my company need to calculate area of existing polygons, hatches and polylines. A lot of people worked on same project and that is why we have different types of geometry. I can manually change all of this to closed polylines but there is over 2000 polygons and hatches. Is there any lsp which can calculate all types of geometry? I tried many but they are just calculating closed polylines. Thank you very much and sorry for bad english

Hi.. I draw a circle inside the hath, and I couldn't trim the hath inside the circle. 1-My hatch and circle elevation are at the same level. 2-I tried both Associative and non-Associative hatch. 3-The layers are not locked. you can find the attached drawing here. SAMPLE-TRIM-HATCH.dwg Thanks

Trim split hatch with holes problem !! Why after trim hatch there is holes in trimmed parts. HATCH TRIM.dwg