Leaderboard

Think this should do it (defun AT:NumFix (s n) ;; Fix number string with leading zeros ;; s - Number string to fix ;; n - Number of characters for final string ;; Alan J. Thompson, 10.29.09 ;; (AT:NumFix i 2) i= 5 = 05 (if (< (strlen s) n) (AT:NumFix (strcat "0" s) n) s ) )

; POINTGRID - 2023.08.17 exceed ; https://www.cadtutor.net/forum/topic/76068-point-grid-by-selecting-polyline/?do=findComment&comment=622077 ; Make point grid in closed polyline or circle. ; command : POINTGRID ; 1. Select objects to use as boundary. ; 2. Enter the x, y spacing gap value between each point. ; 3. If you want to give a margin to the inside of the boundary object, enter an offset value. ; (Enter the space bar if not necessary.) ; This code modifies PDMODE and PDSIZE variable for visibility. you can modify it to you want. (defun c:POINTGRID ( / ss x_gap y_gap base_offset ssl index ent obj minpt maxpt x_dist y_dist x_count y_count x_val y_val x_return pt_val judge point_output ) (vl-load-com) (princ "\n pick boundary polyline : ") (setq ss (ssget)) (setq x_gap (abs (getreal "\n input x gap : "))) (setq y_gap (abs (getreal "\n input y gap : "))) (setvar 'pdmode 33) (setvar 'pdsize (/ (min x_gap y_gap) 5)) (setq base_offset (getreal "\n input inside offset (if required) : ")) (if (= base_offset nil) (setq base_offset 0) (setq base_offset (abs base_offset))) (setq ssl (sslength ss)) (setq ss2 (ssadd)) (setq index 0) (repeat ssl (setq ent (ssname ss index)) (if (> base_offset 0) (progn (setq obj (EX:InsideOffsetOnce (vlax-ename->vla-object ent) base_offset)) ) (setq obj (vlax-ename->vla-object ent)) ) (vla-GetBoundingBox obj 'minpt 'maxpt) (setq minpt (vlax-safearray->list minpt)) (setq maxpt (vlax-safearray->list maxpt)) (setq x_dist (- (- (car maxpt) (car minpt)) base_offset)) (setq y_dist (- (- (cadr maxpt) (cadr minpt)) base_offset)) (setq x_count (fix (/ x_dist x_gap))) (setq y_count (fix (/ y_dist y_gap))) (setq x_val (+ (car minpt) base_offset)) (setq x_return x_val) (setq y_val (+ (cadr minpt) base_offset)) (repeat (+ y_count 1) (repeat (+ x_count 1) (setq pt_val (list x_val y_val)) (if (setq judge (@cv_inside pt_val (vlax-vla-object->ename obj) 1)) (progn ;(princ "\n ") ;(princ judge) ;(princ pt_val) ;(princ " : it's inside") ;(setq circletest (entmakex (list '(0 . "CIRCLE") (cons 10 pt_val) (cons 62 8) (cons 40 (/ (min x_gap y_gap) 5))))) (setq point_output (entmakex (list (cons 0 "POINT") (cons 100 "AcDbEntity") (cons 67 0) (cons 100 "AcDbPoint") (cons 10 pt_val ) (cons 50 0)))) (setq ss2 (ssadd point_output ss2)) ) (progn ;(princ "\n ") ;(princ judge) ;(princ pt_val) ;(princ " : it's not inside") ) ) (setq x_val (+ x_val x_gap)) ) (setq x_val x_return) (setq y_val (+ y_val y_gap)) ) (if (> base_offset 0) (vla-delete obj) ) (setq index (+ index 1)) ) (princ "\n complete") (redraw) (sssetfirst nil ss2) (princ) ) ; EX:InsideOffsetOnce - 2023.08.01 exceed ; Inside Offsets the "obj" object entered as an argument inward by "offdis" numeric value. (defun EX:InsideOffsetOnce ( obj offdis / offsetobj subloop1 subloop2 subloop1type subloop2type subloop1length subloop2length looplength ) (if (vlax-method-applicable-p obj 'offset) (progn (setq subloop1 (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method obj 'Offset (* offdis 1)))))) (setq subloop2 (car (vlax-safearray->list (vlax-variant-value (vlax-invoke-method obj 'Offset (* offdis -1)))))) (setq subloop1type (vlax-get-property subloop1 'ObjectName)) (setq subloop2type (vlax-get-property subloop2 'ObjectName)) (cond ((= subloop1type "AcDbPolyline") (setq subloop1length (vlax-get-property subloop1 'length))) ((= subloop1type "AcDbCircle") (setq subloop1length (vlax-get-property subloop1 'Circumference))) ((= subloop1type "AcDbArc") (setq subloop1length (vlax-get-property subloop1 'Radius))) ) (cond ((= subloop2type "AcDbPolyline") (setq subloop2length (vlax-get-property subloop2 'length))) ((= subloop2type "AcDbCircle") (setq subloop2length (vlax-get-property subloop2 'Circumference))) ((= subloop2type "AcDbArc") (setq subloop2length (vlax-get-property subloop2 'Radius))) ) (cond ((> subloop1length subloop2length) (vla-delete subloop1) (setq offsetobj subloop2)) ((< subloop1length subloop2length) (vla-delete subloop2) (setq offsetobj subloop1)) ((= subloop1length subloop2length) (vla-delete subloop2) (setq offsetobj subloop1)) ) offsetobj ) (progn (princ "\n This Object Cannot be Offset") ) ) ) ; Joe Burke - https://www.theswamp.org/index.php?topic=7785.msg98782#msg98782 (defun @cv_inside (PIQ Object Draw / IsPolyline Closest Start End Param P ClosestParam NextParam a1 a2 Defl @2D @Insect @Bulge @Deflect @Closest Color) ;; "LOOK, MA'... NO RAYS!" ;; @Inside.lsp v1.0 (09-15-03) John F. Uhden, Cadlantic. ;; v2.0 Revised (09-17-03) - See notes below. ;; v3.0 Revised (09-20-03) - See notes below. ;; v4.0 Revised (09-20-04) but still missing something ;; v5.0 Revised (04-04-04) - See notes below. ;; Function to determine whether a point is inside the boundary ;; of a closed curve. ;; It employs the theorem that the sum of the deflections of a ;; point inside the curve should equal 360°, and if outside 0° ;; (both absolute values). ;; ;; Arguments: ;; PIQ - Point to test (2D or 3D point as a list in UCS) ;; Object - Curve to test (Ename or VLA-Object) ;; Draw - Option to draw vectors to sample points, nil or non-nil ;; ;; Returns: ;; T (if the PIQ is inside the curve) ;; nil (if either the arguments are invalid, ;; or the PIQ is on or outside the curve) ;; ;; NOTES: ;; Requires one or another version of the @delta function, ;; such as included here. ;; It will not work well with self-intersecting (overlapping) ;; bulged polyline segments. ;; Curves can be CIRCLEs, ELLIPSEs, LWPOLYLINEs, POLYLINES, ;; SPLINEs, and maybe even more. ;; Since all the calulations are based on angles relative to the ;; current UCS, there shouldn't be any limitation caused by differences ;; in elevation, but it is not suited for abnormal extrusion directions. ;; (09-17-03) Found that cusps brought back inside the figure ;; yield a total deflection of (* pi 2), so changed evaluation ;; to see if deflection was greater than 4, which is ;; equivalent to a fuzz factor of 2.28 from (* pi 2). ;; (09-20-03) Found that bulged polyline segments needed special ;; attention to determine the closest point to any segment because ;; it might not be the closest point to the object, but must be ;; evaluated to sample sufficient points. ;; (04-04-04) Renamed to original @cv_Inside.lsp (c. 2002) ;; Remembered there was an issue with splines, so included is a ;; Closest evaluation, and a small sample increment, Though I still ;; don't trust the results when the PIQ is near a sharp curve. If splines ;; important then make the sample rate tighter at the expense of speed. ;; For polylines, the sample increment just 1.0 as there is a special ;; subfunction to pick up the midpoint and closest point of bulged segments. ;; For objects such as circles and ellipses the sample increment should be ;; a multiple of pi to achieve a total deflection that is a multiple of pi ;; with in a small fuzz factor. ;; Yes, circles and ellipses can be evaluated more easily by a simple ;; comparison of distances to their center, but this function is ;; intended to treat them as just another curve and to demonstrate ;; the method of using curve parameters and deflections. (vl-load-com) ;; Subunction to determine the deflection angle in radians beween two given angles (or (= (type @delta) 'SUBR) (defun @delta (a1 a2) (cond ((> a1 (+ a2 pi)) (+ a2 pi pi (- a1)) ) ((> a2 (+ a1 pi)) (- a2 a1 pi pi) ) (1 (- a2 a1)) ) ) ) ;; Subfunction to convert a 3D point into 2D for the purpose ;; of ignoring the Z value. ;; Added (09-20-03) (defun @2D (p)(list (car p)(cadr p))) ;;-------------------------------------------------------- ;; Subfunction to determine if an angle is with the sector ;; defined by two other angles. (defun @Insect (Ang Ba Ea) (if (> Ba Ea) (cond ((>= Ang Ba)) ((<= Ang Ea)) (1 nil) ) (< Ba Ang Ea) ) ) ;; Subfunction to find the closest point to an object from a given point, ;; adjusted for elevation differences. Input and output are in UCS (defun @Closest (P / P1 P2) (setq P (trans P 1 0) P2 P ) (while (not (equal P1 P2 1e-10)) (setq P1 P2 P2 (vlax-curve-GetClosestPointTo Object P) P (list (car P)(cadr P)(last P2)) ) ) (trans P2 0 1) ) ;; Subfunction to emulate the GetBulge method, which can be used only ;; for simple polylines, not for fit-curved or splined. ;; Its dual purpose here is to find a point on a bulged segment closest to ;; the PIQ if it is within the bulge's sector and/or the midpoint of ;; the bulged segment, and to compute deflections to same in ascending ;; parameter order. (defun @Bulge (Param / V1 V2 P1 P2 Center Ba Ea Ma MidParam Delta Radius Swap Ang P) (and ;; once again the Koster approach (< Param End) (setq Param (fix Param)) (setq MidParam (+ Param 0.5)) (setq V1 (vlax-curve-getpointatparam Object Param)) (setq V2 (vlax-curve-getpointatparam Object MidParam)) (setq Ba (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object Param))))) (setq Ea (apply 'atan (reverse (@2d (vlax-curve-getSecondDeriv Object MidParam))))) (not (equal Ba Ea 1e-8)) (setq P1 (polar V1 Ba 1.0)) (setq P2 (polar V2 Ea 1.0)) (setq Center (inters V1 P1 V2 P2 nil)) (setq Radius (distance Center V1)) (setq Ba (angle Center V1)) ; Beginning angle (setq V2 (vlax-curve-getpointatparam Object (1+ Param))) (setq Ea (angle Center V2)) ; End angle (setq Ma (angle Center (vlax-curve-getpointatparam Object MidParam))) ; Mid angle (setq MidP (trans (vlax-curve-GetPointAtParam Object MidParam) 0 1)) ;; Since we don't have the value of bulge, and since the internal angle (Delta) ;; can be > pi, cut the segment in half and add up the separate deflections: (setq Delta (+ (@delta Ba Ma)(@delta Ma Ea))) ;; If you had a Tan function, then you could ;; (setq Bulge (Tan (/ Delta 4))) (or (> Delta 0) (setq Swap Ba Ba Ea Ea Swap) ) (setq Ang (angle Center (trans PIQ 1 0))) (if (@Insect Ang Ba Ea) (setq P (trans (polar Center Ang Radius) 0 1) P (@Closest P) PParam (vlax-curve-GetParamAtPoint Object (trans P 1 0)) ) ) (cond ((or (not PParam)(= PParam MidParam)) (@Deflect MidP 3) ; in UCS ) ((< PParam MidParam) (@Deflect P 1) ; in UCS (@Deflect MidP 3) ; in UCS ) ((> PParam MidParam) (@Deflect MidP 3) ; in UCS (@Deflect P 1) ; in UCS ) ) ) ) (defun @Deflect (P Color) (setq a2 (angle PIQ P) ; in UCS Defl (+ Defl (@delta a1 a2)) a1 a2 ) ;(if Draw (grdraw PIQ P Color)) ) ;;========================================================= ;; Begin input validation and processing using the ;; Steph(and) Koster approach which simply stops evaluating ;; on any nil result: (and ;; Validate input object: (cond ((not Object) (prompt " No object provided.") ) ((= (type Object) 'VLA-Object)) ((= (type Object) 'Ename) (setq Object (vlax-ename->vla-object Object)) ) (1 (prompt " Improper object type.")) ) ;; Validate input point: (or (and (< 1 (vl-list-length PIQ) 4) (vl-every 'numberp PIQ) ) (prompt " Improper point value.") ) ;; Validate that object is a curve: (or (not (vl-catch-all-error-p (setq Start (vl-catch-all-apply 'vlax-curve-getStartPoint (list Object) ) ) ) ) (prompt " Object is not a curve.") ) ;; Validate that curve is closed: (or (equal Start (vlax-curve-getendpoint Object) 1e-10) (prompt " Curve is not closed.") ) (setq Closest (@Closest PIQ)) ; in UCS ;; Test to see if PIQ is on object: (not (equal (@2D PIQ)(@2D Closest) 1e-10)) ; in WCS (setq ClosestParam (vlax-curve-getparamatpoint Object (trans Closest 1 0))) (or (not Draw) (not (grdraw PIQ Closest 2))) (setq IsPolyline (wcmatch (vla-get-objectname Object) "*Polyline") End (vlax-curve-getEndparam Object) ) ;; Set the sample rates based on object type and end parameter. (cond (IsPolyline (setq ClosestParam nil) (setq Sample 1.0) ) ((equal (rem End pi) 0.0 1e-10) (setq Sample (* pi 0.2)) ) ((setq Sample (* End 0.01))) ) ;; Initialize the values to be incremented and computed: (setq Param Sample Defl 0.0) (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS ;; Iterate through the object by parameter: (while (<= Param End) (setq Param (min Param End)) ;; This little extra makes sure not to skip an angle ;; that might throw off the total deflection. ;; It is at the top of while loop in case ClosestParam ;; is less than the first sample. ;; This is not to be used with polylines. (if (and ClosestParam (> Param ClosestParam)) (setq P Closest ClosestParam nil NextParam Param Color 2 ) (setq P (trans (vlax-curve-getpointatparam Object Param) 0 1) NextParam (+ Param Sample) Color 3 ) ) (@Deflect P Color) ; in UCS ;; For polylines check for additional points on any ;; bulged segment. (if IsPolyline (@Bulge Param)) (setq Param NextParam) ) ;(if Draw (print Defl)) ; Optional display of results (> (abs Defl) 4) ; to allow for rough calculations if ; sample rates are too high (large). ) )

Ok easier is use radio buttons, they have inbuilt only 1 can be selected on so have say 3 buttons Just a comment maybe use 2 columns so hatch stuff is in right hand column. Tidy up the dcl. If you post the dcl there are some people here that are very proficient in dcl's.

"File not found... ERR_FILE_NOT_FOUND" working with the Block Palette in AutoCAD (autodesk.com)

I use @Lee Mac Areas2Attribute http://www.lee-mac.com/areafieldtoattribute.html

You're most welcome, I'm glad it helps. Those are DXF group code (I simply pad them to 3 digits to please my OCD) - here is a DXF reference. Navigate to ENTITIES and then review Common Group Codes and those for TEXT entity. We can change the acquisition of the points from an if to a while - consider the following: (defun c:bd ( / ang ber dis mid pt1 pt2 scl ) (initget 6) (if (setq scl (getreal "\nSpecify drawing scale: ")) (while (and (setq pt1 (getpoint "\nSpecify 1st point <exit>: ")) (setq pt2 (getpoint "\nSpecify 2nd point <exit>: " pt1)) ) (setq ang (angle pt1 pt2) dis (* scl 0.001 (distance pt1 pt2)) mid (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2) ) (entmake (list '(000 . "TEXT") '(008 . "DIM") '(062 . 256) '(006 . "BYLAYER") '(040 . 2.0) '(072 . 1) '(073 . 2) (cons 007 (if (tblsearch "style" "SS") "SS" (getvar 'textstyle))) (cons 010 (polar mid (+ ang (/ pi 2.0)) 5.0)) (cons 011 (polar mid (+ ang (/ pi 2.0)) 5.0)) (cons 050 ang) (cons 001 (vl-string-translate "." "|" (rtos dis 2 3))) ) ) (setq ber (angtos ang) ber (vl-string-subst "%%d" "d" ber) ber (vl-string-subst "%%135" "'" ber) ber (vl-string-subst "%%136" "\"" ber) ) (entmake (list '(000 . "TEXT") '(008 . "BEAR") '(062 . 256) '(006 . "BYLAYER") '(040 . 2.0) '(072 . 1) '(073 . 2) (cons 007 (if (tblsearch "style" "SU") "SU" (getvar 'textstyle))) (cons 010 (polar mid (+ ang (/ pi 2.0)) 2.5)) (cons 011 (polar mid (+ ang (/ pi 2.0)) 2.5)) (cons 050 ang) (cons 001 ber) ) ) ) ) (princ) )

Hi SLW Here is a better approximation of cylindrical gradients. Don't ask what those numbers are. Long story. I forgot to tell you, the spherical gradients family is ignored. That would be the challenge... Also, there is a property of gradient, "Centered", which in your case is always true. If you change it to not centered, the gradient is shifted and that's another story for another day. ;Replace gradient Hatch with lines ;Stefan M - 12.08.2023 (defun c:gradline ( / *error* o ss i e a col1 col2 en l c x1 x2 c1 c2 rgb r m q ) ;(setq *error* (err)) (setq o (vlax-3d-point 0.0 0.0 0.0)) (or *spacing* (setq *spacing* 0.1)) (or *del* (setq *del* "No")) (if (and (setq ss (ssget "_:L" '((0 . "HATCH") (450 . 1) (470 . "LINEAR,CYLINDER,INVCYLINDER")))) (progn (initget 6) (setq *spacing* (cond ((getdist (strcat "\nSpecify line spacing <" (rtos *spacing*) ">: "))) (*spacing*) ) ) ) (progn (initget "Yes No") (setq *del* (cond ((getkword (strcat "\nDelete original hatch [Yes/No] <" *del* ">: "))) (*del*) ) ) ) ) (repeat (setq i (sslength ss)) (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))) a (vla-get-gradientangle e) col1 (vla-get-gradientcolor1 e) col2 (vla-get-gradientcolor2 e) ) (setq en (entlast) l nil) (setq c (vla-copy e)) (vla-rotate c o (- a)) (vla-getboundingbox c 'x1 'x2) (setq x1 (car (vlax-safearray->list x1)) x2 (car (vlax-safearray->list x2)) ) (if (> (- x2 x1) *spacing*) (progn (vla-put-HatchObjectType c acHatchObject) (vla-setpattern c acHatchPatternTypeUserDefined "_USER") (vla-put-patternangle c (/ pi 2)) (vla-put-patternscale c *spacing*) (setq c1 (mapcar '(lambda (p) (vlax-get col1 p)) '(red green blue)) c2 (mapcar '(lambda (p) (vlax-get col2 p)) '(red green blue)) ) (if (eq (vla-get-gradientname e) "INVCYLINDER") (mapcar 'set '(c1 c2) (list c2 c1)) ) (vla-put-truecolor c col1) (command "_explode" (vlax-vla-object->ename c)) (while (setq en (entnext en)) (setq l (cons (list (car (vlax-curve-getstartpoint en)) (vlax-ename->vla-object en) ) l ) ) ) (foreach x l (if (eq (vla-get-gradientname e) "LINEAR") (setq rgb (mapcar '(lambda (c1 c2) (fix (+ 0.5 c1 (/ (* (- c2 c1) (- (car x) x1)) (- x2 x1)))) ) c1 c2 ) ) (progn (setq r (/ (- x2 x1) 2.0) m (/ (+ x2 x1) 2.0) q (/ (- m (car x)) r) rgb (mapcar '(lambda (c1 c2) (fix (+ 0.5 c1 (* (- c2 c1) (+ (* 0.2684 (expt q 4)) (* -1.2598 (expt q 2)) 0.9954)))) ) c1 c2 ) ) ) ) (vla-setrgb col1 (car rgb) (cadr rgb) (caddr rgb)) (vla-put-truecolor (cadr x) col1) (vla-rotate (cadr x) o a) ) (if (eq *del* "Yes") (vla-delete e)) ) ) ) ) ;(*error* nil) (princ) )

Hi SLW This one works OK with LINEAR gradients, but for some reason, it doesn't match exactly the Cylindrical ones. I tried various interpolation methods, but none seems accurate. ;Replace gradient Hatch with lines ;Stefan M - 12.08.2023 (defun c:gradline ( / *error* o ss i e a col1 col2 en l c x1 x2 c1 c2 rgb r m ) ;;; (setq *error* (err)) (setq o (vlax-3d-point 0.0 0.0 0.0)) (or *spacing* (setq *spacing* 0.1)) (or *del* (setq *del* "No")) (if (and (setq ss (ssget "_:L" '((0 . "HATCH") (450 . 1) (470 . "LINEAR,CYLINDER,INVCYLINDER")))) (progn (initget 6) (setq *spacing* (cond ((getdist (strcat "\nSpecify line spacing <" (rtos *spacing*) ">: "))) (*spacing*) ) ) ) (progn (initget "Yes No") (setq *del* (cond ((getkword (strcat "\nDelete original hatch [Yes/No] <" *del* ">: "))) (*del*) ) ) ) ) (repeat (setq i (sslength ss)) (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))) a (vla-get-gradientangle e) col1 (vla-get-gradientcolor1 e) col2 (vla-get-gradientcolor2 e) ) (setq en (entlast) l nil) (setq c (vla-copy e)) (vla-rotate c o (- a)) (vla-getboundingbox c 'x1 'x2) (setq x1 (car (vlax-safearray->list x1)) x2 (car (vlax-safearray->list x2)) ) (if (> (- x2 x1) *spacing*) (progn (vla-put-HatchObjectType c acHatchObject) (vla-setpattern c acHatchPatternTypeUserDefined "_USER") (vla-put-patternangle c (/ pi 2)) (vla-put-patternscale c *spacing*) (setq c1 (mapcar '(lambda (p) (vlax-get col1 p)) '(red green blue)) c2 (mapcar '(lambda (p) (vlax-get col2 p)) '(red green blue)) ) (if (eq (vla-get-gradientname e) "INVCYLINDER") (mapcar 'set '(c1 c2) (list c2 c1)) ) (vla-put-truecolor c col1) (command "_explode" (vlax-vla-object->ename c)) (while (setq en (entnext en)) (setq l (cons (list (car (vlax-curve-getstartpoint en)) (vlax-ename->vla-object en) ) l ) ) ) (foreach x l (if (eq (vla-get-gradientname e) "LINEAR") (setq rgb (mapcar '(lambda (c1 c2) (fix (+ 0.5 c1 (/ (* (- c2 c1) (- (car x) x1)) (- x2 x1)))) ) c1 c2 ) ) (progn (setq r (/ (- x2 x1) 2.0) m (/ (+ x2 x1) 2.0) rgb (mapcar '(lambda (c1 c2 / q u) (setq q (abs (- m (car x))) u (atan (/ (sqrt (- (* r r) (* q q))) q)) ) (fix (+ 0.5 c1 (/ (* (- c2 c1) 2 u) pi))) ) c1 c2 ) ) ) ) (vla-setrgb col1 (car rgb) (cadr rgb) (caddr rgb)) (vla-put-truecolor (cadr x) col1) (vla-rotate (cadr x) o a) ) (if (eq *del* "Yes") (vla-delete e)) ) ) ) ) ;;; (*error* nil) (princ) )

Consider the following code - (defun c:bd ( / ang ber dis mid pt1 pt2 scl ) (initget 6) (if (and (setq scl (getreal "\nSpecify drawing scale: ")) (setq pt1 (getpoint "\nSpecify 1st point: ")) (setq pt2 (getpoint "\nSpecify 2nd point: " pt1)) ) (progn (setq ang (angle pt1 pt2) dis (* scl 0.001 (distance pt1 pt2)) mid (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2) ) (entmake (list '(000 . "TEXT") '(008 . "DIM") '(062 . 256) '(006 . "BYLAYER") '(040 . 2.0) '(072 . 1) '(073 . 2) (cons 007 (if (tblsearch "style" "SS") "SS" (getvar 'textstyle))) (cons 010 (polar mid (+ ang (/ pi 2.0)) 5.0)) (cons 011 (polar mid (+ ang (/ pi 2.0)) 5.0)) (cons 050 ang) (cons 001 (vl-string-translate "." "|" (rtos dis 2 3))) ) ) (setq ber (angtos ang) ber (vl-string-subst "%%d" "d" ber) ber (vl-string-subst "%%135" "'" ber) ber (vl-string-subst "%%136" "\"" ber) ) (entmake (list '(000 . "TEXT") '(008 . "BEAR") '(062 . 256) '(006 . "BYLAYER") '(040 . 2.0) '(072 . 1) '(073 . 2) (cons 007 (if (tblsearch "style" "SU") "SU" (getvar 'textstyle))) (cons 010 (polar mid (+ ang (/ pi 2.0)) 2.5)) (cons 011 (polar mid (+ ang (/ pi 2.0)) 2.5)) (cons 050 ang) (cons 001 ber) ) ) ) ) (princ) )

I use a function such as the following - ;; Readable - Lee Mac ;; Returns an angle corrected for text readability. (defun LM:readable ( a ) ( (lambda ( a ) (if (< a 0.0) (LM:readable a) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (LM:readable (+ a pi)) a ) ) ) (rem (+ a pi pi) (+ pi pi)) ) )

I made something. A few remarks: - For my ease I made it 1 unit = 1 smallest paver. So I ignored the 8" size. You can always scale the result by 8 at the end. - The driveway starts at 0,0 . Then you pick a second point (both X and Y must be positive). Start small. (x=10, y=25 for example) - The algorithm will pick a random point, then a random pavers size (we skip the smallest paver), and a random orientation (horizontal or vertical) If there's room for that paver there, then it's drawn there. Else skip. This is done 3000 times (you can change this number) - At the end the smallest paver fills all the rest at the end command PAVER The script needs some cleanup; I just got it working. I might edit the script to clean it up. TODO. It might be nice to put a factor in the pavers, so that big pavers are randomly selected more or less often than small ones. You can add pavers sizes to the pavers_size list. Make sure the first size is 1,1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DRAW (defun drawLWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) (defun drawLWPoly_color (lst cls col) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 62 col) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ROUNDING ;; http://www.lee-mac.com/round.html ;; Round Multiple - Lee Mac ;; Rounds 'n' to the nearest multiple of 'm' (defun LM:roundm ( n m ) (* m (fix ((if (minusp n) - +) (/ n (float m)) 0.5))) ) ;; Round Up - Lee Mac ;; Rounds 'n' up to the nearest 'm' (defun LM:roundup ( n m ) ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r)) ((+ n (- m r))))) (rem n m)) ) ;; Round Down - Lee Mac ;; Rounds 'n' down to the nearest 'm' (defun LM:rounddown ( n m ) ((lambda ( r ) (cond ((equal 0.0 r 1e-8) n) ((< n 0) (- n r m)) ((- n r)))) (rem n m)) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; RANDOM number generator ;; http://www.lee-mac.com/random.html ;; Rand - Lee Mac ;; PRNG implementing a linear congruential generator with ;; parameters derived from the book 'Numerical Recipes' (defun LM:rand ( / a c m ) (setq m 4294967296.0 a 1664525.0 c 1013904223.0 $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m) ) (/ $xn m) ) ;; Random in Range - Lee Mac ;; Returns a pseudo-random integral number in a given range (inclusive) (defun LM:randrange ( a b ) (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b)))))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Replace item in list (defun replace-element (index newelement lst) (subst newelement (nth index lst) lst) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; XY coordinates to array index ;; vice versa is just (nth index pavers) (defun yx2index ( x y pavers / res i) ;;(setq x_ (rem x w)) ;;(setq y_ (LM:rounddown (/ ind w) 1.0)) (setq i 0) (foreach cel pavers (if (and (= x (nth 0 cel)) (= y (nth 1 cel)) ) (setq res i) ) (setq i (+ i 1)) ) res ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:pavers ( / bl tr p1 p2 driveway_pl pixels pix w h x y a rnd rot ind ind_ blk paver pixelsfree counter stopcounter) (setq stopcounter 3000) ;; number of times it will try to put a randow paver on a random place (setq pavers_size (list (list 1 1) (list 2 1) (list 2 2) (list 3 2) )) ;;(setq p1 (getpoint "\nPoint bottom left: ")) (setq p1 (list 0.0 0.0)) (setq p2 (getcorner p1 "\nPoint top right: ")) ;; now round down the coordinates to multiples of the size of the smallest pavers (setq bl (list (LM:rounddown (nth 0 p1) 1 ) (LM:rounddown (nth 1 p1) 1 ) )) (setq tr (list (LM:rounddown (nth 0 p2) 1 ) (LM:rounddown (nth 1 p2) 1 ) )) ;; draw driveway (drawLWPoly (list (list (nth 0 bl) (nth 1 bl) ) (list (nth 0 tr) (nth 1 bl) ) (list (nth 0 tr) (nth 1 tr) ) (list (nth 0 bl) (nth 1 tr) ) ) 1) ;; make a list of pixels (setq w (- (nth 0 tr) (nth 0 bl))) (setq h (- (nth 1 tr) (nth 1 bl))) ;; round down and turn into integer (setq w (atoi (rtos w 2 0))) (setq h (atoi (rtos h 2 0))) (setq pixels (list)) (setq x 0) (setq y 0) (repeat h (setq x 0) (repeat w (setq pixels (append pixels (list (list x y nil) ;; the nil means the pixel is empty and can/must be filled by a paver ))) (setq x (+ x 1)) ) (setq y (+ y 1)) ) ;;(princ pixels) ;;(while (/= "a" (getstring "\nPress enter for random pixel") ) (setq counter 0) (while (< counter stopcounter) ;; random pixel (setq rnd (LM:randrange 0 (- (length pixels) 1))) ;; random orientation (0 = 0°, 1 = 90°) ;;(setq rot (/ (* pi (LM:randrange 0 1)) -2) ) (setq rot (LM:randrange 0 1)) ;; 0 means horizontal, 1 means vertical (this doesn't matter for square pavers obviously) ;; random paver block. ind is the index of the paver. ;; Let's skip the smallest paver, as it will fill up any place that doesn't fit any bigger. ;;(setq blk (nth (setq ind (LM:randrange 1 (length pavers_name))) pavers_name )) (setq paver (nth (setq ind (LM:randrange 1 (- (length pavers_size) 1))) pavers_size )) (setq pix (nth rnd pixels)) ;; now put a paver there ;;(drawInsert_rot (list (nth 0 pix) (nth 1 pix)) blk rot) (setq pixels_taken (list)) ;; draw paver (if (= 0 rot) ;; horizontal T ;; vertical (setq paver (list (nth 1 paver) (nth 0 paver))) ;; swap Width / height ) (progn ;; pixels taken: ;; width = (nth 0 paver) ;; height = (nth 1 paver) (setq x (nth 0 pix)) (setq y (nth 1 pix)) (setq pixelsfree T) (repeat (nth 1 paver) (setq x (nth 0 pix)) (repeat (nth 0 paver) (setq ind_ (yx2index x y pixels)) (setq pixels_taken (append pixels_taken (list ind_))) (if (or (= ind_ nil) ;; pixels outside the driveway (nth 2 (nth ind_ pixels)) ;; pixels already taken ) (setq pixelsfree nil) ) (setq x (+ x 1)) ) (setq y (+ y 1)) ) (if pixelsfree (progn (foreach a pixels_taken ;; set (nth 2) to true (setq pixels (replace-element a (list (nth 0 (nth a pixels)) (nth 1 (nth a pixels)) T) pixels)) ) (drawLWPoly_color (list (list (nth 0 pix) (nth 1 pix) ) (list (+ (nth 0 pix) (nth 0 paver) ) (nth 1 pix) ) (list (+ (nth 0 pix) (nth 0 paver) ) (+ (nth 1 pix) (nth 1 paver)) ) (list (nth 0 pix) (+ (nth 1 pix) (nth 1 paver)) ) ) 1 ind ) ) ;;(princ "*") ) ) ;;(setq (nth 1 pix)) (setq counter (+ counter 1)) ) ;;(princ pixels) ;; fill the rest with 1/1 pavers (foreach pix pixels (if (not (nth 2 pix)) (drawLWPoly_color (list (list (nth 0 pix) (nth 1 pix) ) (list (+ (nth 0 pix) 1 ) (nth 1 pix) ) (list (+ (nth 0 pix) 1 ) (+ (nth 1 pix) 1) ) (list (nth 0 pix) (+ (nth 1 pix) 1) ) ) 1 0 ) ) ) )