RockyMarc Posted July 27, 2010 Posted July 27, 2010 G'day, We have recently been taken over by a new company, we are now using AutoCAD 2009 before using AutoCAD 2006 with custom cad designed by a software guru, who is know not with us. We use to have this great Dirt / Soil LISP that would follow a line with Nearest sticky and draw in the Dirt as a hatch (using Earth hatch) at any length you wanted, and also to scale (picture attached). Now we have StrucPLUS AutoCAD package and it has a pretty ordinary Dirt / Soil Block which does scale but only comes as the Block size and you can't stretch it or anything unless you explode it (ugh lines!). Just wondering if anyone out there has a Dirt / Soil LISP like I explained ? Cheers! Quote
The Buzzard Posted July 27, 2010 Posted July 27, 2010 G'day, We have recently been taken over by a new company, we are now using AutoCAD 2009 before using AutoCAD 2006 with custom cad designed by a software guru, who is know not with us. We use to have this great Dirt / Soil LISP that would follow a line with Nearest sticky and draw in the Dirt as a hatch (using Earth hatch) at any length you wanted, and also to scale (picture attached). Now we have StrucPLUS AutoCAD package and it has a pretty ordinary Dirt / Soil Block which does scale but only comes as the Block size and you can't stretch it or anything unless you explode it (ugh lines!). Just wondering if anyone out there has a Dirt / Soil LISP like I explained ? Cheers! I am not exactly sure, But you are welcome to these. It could be in there. Please see attached. aec20patterns.zip Quote
RockyMarc Posted July 27, 2010 Author Posted July 27, 2010 Hmm not really, they are just hatch patterns. I was after a lisp that would invoke the Earth hatch pattern (standard one) at a certain scale & at 45deg. that would let me pick 2 points on a line and would plonk that hatch down. Quote
The Buzzard Posted July 27, 2010 Posted July 27, 2010 Sorry about that. Maybe something will come along. Quote
lpseifert Posted July 27, 2010 Posted July 27, 2010 Try making a block of the earth hatch (at the size/angle you would like to see it plotted); then drag it to a Toolpalette. In the properties of the new 'tool' you can have it inserted at an 'Auxiliary scale' (Dimscale, Plot scale) and also have it 'Prompt for rotation' (2 points). Quote
RockyMarc Posted July 27, 2010 Author Posted July 27, 2010 That only gives you a certain size of the block though ? Like once you make it that size (as in length along the line) it is that same size everytime you insert it ? I like to make them all different to give a not so perfect look about the drawings Quote
The Buzzard Posted July 27, 2010 Posted July 27, 2010 (edited) That only gives you a certain size of the block though ?Like once you make it that size (as in length along the line) it is that same size everytime you insert it ? I like to make them all different to give a not so perfect look about the drawings Something I just threw together. May need some tweaking. Earth.lsp Type Earth to start. ;///////////////////////////////////////////////////////////////////////////////////////// ; (defun C:EARTH (/ CL01 CL02 RAD# DEG# PT01 PT02 PT03 PT04 DLEN E01 SCL WID ANG) (setq PRP "EARTH") (setq WID 12) (setq SCL 12) (setq ANG 0) (setq CL01 (getpoint "\nSpecify first point: ") CL02 (getpoint CL01 "\nSpecify second point: ") RAD# (angle CL01 CL02) DEG# (RTD RAD#) DLEN (distance CL01 CL02) CL01 (trans CL01 1 0) CL02 (trans CL02 1 0) PT01 CL01 PT02 (polar PT01 (DTR (+ DEG# 0)) DLEN) PT03 (polar PT01 (DTR (+ DEG# 270)) WID) PT04 (polar PT02 (DTR (+ DEG# 270)) WID)) (command "._pline" PT01 PT02 PT04 PT03 "C") (setq E01 (entlast)) (command "._-bhatch" "_a" "_a" "_y" "" "_p" PRP SCL ANG "_s" "_l" "" "") (command "._erase" E01 "") (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; (defun DTR (DEG#)(* pi (/ DEG# 180.0))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; (defun RTD (RAD#)(* 180.0 (/ RAD# pi))) ; ;///////////////////////////////////////////////////////////////////////////////////////// Edited July 27, 2010 by The Buzzard Quote
The Buzzard Posted July 27, 2010 Posted July 27, 2010 (edited) This one has more prompts to make it more flexible. Also added an error trap and layer function as well. I commented areas in the code that you may want to change the values. Refer to the values highlighted in red. If you need help with this , Then please mention. EARTH.lsp Type EARTH to start. ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Main Function. ; (defun C:EARTH (/ CL01 CL02 RAD# DEG# PT01 PT02 PT03 PT04 DLEN E01 CPS SUS) (setq SUS_LST (list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits" "clayer")) (setq SUS (mapcar 'getvar SUS_LST)) (setq TERR *error*) (setq *error* EARTH_ET) (or H:PRP (setq H:PRP "[color=red]EARTH[/color]")) ;[color=red]Default Hatch Pattern[/color] (or H:WID (setq H:WID [color=red]6[/color])) ;[color=red]Default Hatch Width[/color] (or H:SCL (setq H:SCL [color=red]6[/color])) ;[color=red]Default Hatch Scale[/color] (or H:ANG (setq H:ANG [color=red]45[/color])) ;[color=red]Default Hatch Angle[/color] (setq H:WID (cond ((getint (strcat "\nSpecify hatch width. <"(rtos H:WID 2 0)">: ")))(T H:WID))) (setq H:SCL (cond ((getint (strcat "\nSpecify hatch scale. <"(rtos H:SCL 2 0)">: ")))(T H:SCL))) (setq H:ANG (cond ((getint (strcat "\nSpecify hatch angle. <"(rtos H:ANG 2 0)">: ")))(T H:ANG))) (setq CL01 (getpoint "\nSpecify first point: ") CL02 (getpoint CL01 "\nSpecify second point: ") RAD# (angle CL01 CL02) DEG# (EARTH_RTD RAD#) DLEN (distance CL01 CL02) CL01 (trans CL01 1 0) CL02 (trans CL02 1 0) PT01 CL01 PT02 (polar PT01 (EARTH_DTR (+ DEG# 0)) DLEN) PT03 (polar PT01 (EARTH_DTR (+ DEG# 270)) H:WID) PT04 (polar PT02 (EARTH_DTR (+ DEG# 270)) H:WID)) (EARTH_CPS) (EARTH_ML "[color=red]HATCH[/color]" [color=red]1[/color] "[color=red]Continuous[/color]" [color=red]18[/color]) ;[color=red]Set layer name, color, linetype, & lineweight[/color] (setvar "clayer" "[color=red]HATCH[/color]") ;[color=red]Set HATCH layer current[/color] (command "._pline" PT01 PT02 PT04 PT03 "C") (setq E01 (entlast)) (command "._-bhatch" "_a" "_a" "_y" "" "_p" H:PRP H:SCL H:ANG "_s" "_l" "" "") (command "._erase" E01 "") (EARTH_RUS) (princ)) (princ) (princ "\nEARTH.lsp loaded... Type EARTH to start.") ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Degrees To Radians. ; (defun EARTH_DTR (DEG#)(* pi (/ DEG# 180.0))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Radians To Degrees. ; (defun EARTH_RTD (RAD#)(* 180.0 (/ RAD# pi))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Make Layer. ; (defun EARTH_ML (LNAM LCLR LTYP LWGT) (if (null (tblsearch "layer" LNAM)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 LNAM) (cons 70 0) (cons 62 LCLR) (cons 6 LTYP) (cons 290 1) (cons 370 LWGT)))) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Change Program Settings. ; (defun EARTH_CPS () (setq CPS (list 0 1 0 0 0 0)) (mapcar (function setvar)(list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits") CPS) (princ)) (princ) ; ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Restore User Settings. ; (defun EARTH_RUS () (setq *error* TERR) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has completed successfully and will now restore your settings.") (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Error Trap. ; (defun EARTH_ET (ERRORMSG) (command nil nil nil) (if (not (member ERRORMSG '("console break" "Function cancelled"))) (princ (strcat "\nError:" ERRORMSG))) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has encountered a user error!") (princ "\nProgram will now restore your settings and exit.") (terpri) (setq *error* TERR) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// Edited July 28, 2010 by The Buzzard Quote
The Buzzard Posted July 30, 2010 Posted July 30, 2010 RockMarc, Is this program working for you or not? Enquiring minds would like to know. Quote
autolisp Posted July 31, 2010 Posted July 31, 2010 This one has more prompts to make it more flexible. Also added an error trap and layer function as well.I commented areas in the code that you may want to change the values. Refer to the values highlighted in red. If you need help with this , Then please mention. EARTH.lsp Type EARTH to start. ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Main Function. ; (defun C:EARTH (/ CL01 CL02 RAD# DEG# PT01 PT02 PT03 PT04 DLEN E01 CPS SUS) (setq SUS_LST (list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits" "clayer")) (setq SUS (mapcar 'getvar SUS_LST)) (setq TERR *error*) (setq *error* EARTH_ET) (or H:PRP (setq H:PRP "[color=red]EARTH[/color]")) ;[color=red]Default Hatch Pattern[/color] (or H:WID (setq H:WID [color=red]6[/color])) ;[color=red]Default Hatch Width[/color] (or H:SCL (setq H:SCL [color=red]6[/color])) ;[color=red]Default Hatch Scale[/color] (or H:ANG (setq H:ANG [color=red]45[/color])) ;[color=red]Default Hatch Angle[/color] (setq H:WID (cond ((getint (strcat "\nSpecify hatch width. <"(rtos H:WID 2 0)">: ")))(T H:WID))) (setq H:SCL (cond ((getint (strcat "\nSpecify hatch scale. <"(rtos H:SCL 2 0)">: ")))(T H:SCL))) (setq H:ANG (cond ((getint (strcat "\nSpecify hatch angle. <"(rtos H:ANG 2 0)">: ")))(T H:ANG))) (setq CL01 (getpoint "\nSpecify first point: ") CL02 (getpoint CL01 "\nSpecify second point: ") RAD# (angle CL01 CL02) DEG# (EARTH_RTD RAD#) DLEN (distance CL01 CL02) CL01 (trans CL01 1 0) CL02 (trans CL02 1 0) PT01 CL01 PT02 (polar PT01 (EARTH_DTR (+ DEG# 0)) DLEN) PT03 (polar PT01 (EARTH_DTR (+ DEG# 270)) H:WID) PT04 (polar PT02 (EARTH_DTR (+ DEG# 270)) H:WID)) (EARTH_CPS) (EARTH_ML "[color=red]HATCH[/color]" [color=red]1[/color] "[color=red]Continuous[/color]" [color=red]18[/color]) ;[color=red]Set layer name, color, linetype, & lineweight[/color] (setvar "clayer" "[color=red]HATCH[/color]") ;[color=red]Set HATCH layer current[/color] (command "._pline" PT01 PT02 PT04 PT03 "C") (setq E01 (entlast)) (command "._-bhatch" "_a" "_a" "_y" "" "_p" H:PRP H:SCL H:ANG "_s" "_l" "" "") (command "._erase" E01 "") (EARTH_RUS) (princ)) (princ) (princ "\nEARTH.lsp loaded... Type EARTH to start.") ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Degrees To Radians. ; (defun EARTH_DTR (DEG#)(* pi (/ DEG# 180.0))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Radians To Degrees. ; (defun EARTH_RTD (RAD#)(* 180.0 (/ RAD# pi))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Make Layer. ; (defun EARTH_ML (LNAM LCLR LTYP LWGT) (if (null (tblsearch "layer" LNAM)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 LNAM) (cons 70 0) (cons 62 LCLR) (cons 6 LTYP) (cons 290 1) (cons 370 LWGT)))) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Change Program Settings. ; (defun EARTH_CPS () (setq CPS (list 0 1 0 0 0 0)) (mapcar (function setvar)(list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits") CPS) (princ)) (princ) ; ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Restore User Settings. ; (defun EARTH_RUS () (setq *error* TERR) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has completed successfully and will now restore your settings.") (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Error Trap. ; (defun EARTH_ET (ERRORMSG) (command nil nil nil) (if (not (member ERRORMSG '("console break" "Function cancelled"))) (princ (strcat "\nError:" ERRORMSG))) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has encountered a user error!") (princ "\nProgram will now restore your settings and exit.") (terpri) (setq *error* TERR) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// dear sir very good lisp thx for sharing but one problem in lisp im pick 1st point end & 2nd point nea hatch is genrete cross Quote
The Buzzard Posted July 31, 2010 Posted July 31, 2010 dear sirvery good lisp thx for sharing but one problem in lisp im pick 1st point end & 2nd point nea hatch is genrete cross Nothing wrong on my end, The code only creates an Earth hatch like the one below. Quote
autolisp Posted July 31, 2010 Posted July 31, 2010 Nothing wrong on my end, The code only create an Earth hatch like the one below. Command: earth Specify hatch width. : 50 Specify hatch scale. : 50 Specify hatch angle. : Specify first point: Specify second point: nea to EARTH.lsp has completed successfully and will now restore your settings. Quote
The Buzzard Posted July 31, 2010 Posted July 31, 2010 [ATTACH]22111[/ATTACH]Command: earth Specify hatch width. : 50 Specify hatch scale. : 50 Specify hatch angle. : Specify first point: Specify second point: nea to EARTH.lsp has completed successfully and will now restore your settings. I just tested with the same values you were using and did not get a problem. I am not sure how you are getting that. Quote
The Buzzard Posted July 31, 2010 Posted July 31, 2010 Ok, I see whats going on now. You went from an extremely large hatch setting and switched back to a much smaller setting. I am not sure what to do about that since it also happens when you manually run the hatch command. If the drawing is closed out and then restarted, All seems to work again. Why you would want to go from one extreme to another is beyond me. I hope I can find a fix for this, But when using, One should use a little common acad sense. Maybe entmake for the hatch would be a better idea. Quote
The Buzzard Posted July 31, 2010 Posted July 31, 2010 (edited) Thanks for testing autolisp, I think I have the issue resolved. I used entmake to create the hatch instead of a command call. There does not seem to be a problem now with changing scale from one extreme to another. Also note the code runs much faster. Earth.lsp ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Main Function. ; ; (defun C:EARTH (/ CL01 CL02 CPS DEG# DLEN E01 HANG HPRP HSCL HWID RAD# PT01 PT02 PT03 PT04 SUS) (setq SUS_LST (list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits" "clayer")) (setq SUS (mapcar 'getvar SUS_LST)) (setq TERR *error*) (setq *error* EARTH_ET) (or H:PRP (setq H:PRP "EARTH")) ;Default Hatch Pattern (or H:WID (setq H:WID 6)) ;Default Hatch Width (or H:SCL (setq H:SCL 6)) ;Default Hatch Scale (or H:ANG (setq H:ANG 45)) ;Default Hatch Angle (setq H:WID (cond ((getint (strcat "\nSpecify hatch width. <"(rtos H:WID 2 0)">: ")))(T H:WID))) (setq H:SCL (cond ((getint (strcat "\nSpecify hatch scale. <"(rtos H:SCL 2 0)">: ")))(T H:SCL))) (setq H:ANG (cond ((getint (strcat "\nSpecify hatch angle. <"(rtos H:ANG 2 0)">: ")))(T H:ANG))) (setq HPRP H:PRP HSCL H:SCL HWID H:WID HANG (EARTH_DTR H:ANG) CL01 (getpoint "\nSpecify first point: ") CL02 (getpoint CL01 "\nSpecify second point: ") RAD# (angle CL01 CL02) DEG# (EARTH_RTD RAD#) DLEN (distance CL01 CL02) CL01 (trans CL01 1 0) CL02 (trans CL02 1 0) PT01 CL01 PT02 (polar PT01 (EARTH_DTR (+ DEG# 0)) DLEN) PT03 (polar PT01 (EARTH_DTR (+ DEG# 270)) HWID) PT04 (polar PT02 (EARTH_DTR (+ DEG# 270)) HWID)) (EARTH_CPS) (EARTH_ML "HATCH" 1 "Continuous" 18) ;Set layer name, color, linetype, & lineweight (setvar "clayer" "HATCH") ;Set HATCH layer current (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 410 "Model") (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.0) (cons 38 0.0) (cons 39 0.0) (cons 10 PT01) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 PT02) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 PT04) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 PT03) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 210 (list 0.0 0.0 1.0)))) (setq E01 (entlast)) (entmake (list (cons 0 "HATCH") (cons 100 "AcDbEntity") (cons 67 0) (cons 410 "Model") (cons 8 "HATCH") (cons 100 "AcDbHatch") (cons 10 (list 0.0 0.0 0.0)) (cons 210 (list 0.0 0.0 1.0)) (cons 2 HPRP) (cons 70 0) (cons 71 0) (cons 91 1) (cons 92 1) (cons 93 4) (cons 72 1) (cons 10 PT01) (cons 11 PT02) (cons 72 1) (cons 10 PT02) (cons 11 PT04) (cons 72 1) (cons 10 PT04) (cons 11 PT03) (cons 72 1) (cons 10 PT03) (cons 11 PT01) (cons 97 0) (cons 75 0) (cons 76 1) (cons 52 HANG) (cons 41 HSCL) (cons 77 0) (cons 78 6) (cons 53 0.785398) (cons 43 0.0) (cons 44 0.0) (cons 45 2.22045e-016) (cons 46 2.12132) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 0.785398) (cons 43 -0.397748) (cons 44 0.397748) (cons 45 2.22045e-016) (cons 46 2.12132) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 0.785398) (cons 43 -0.795495) (cons 44 0.795495) (cons 45 2.22045e-016) (cons 46 2.12132) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 2.35619) (cons 43 -0.795495) (cons 44 1.06066) (cons 45 -2.12132) (cons 46 4.44089e-016) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 2.35619) (cons 43 -0.397748) (cons 44 1.45841) (cons 45 -2.12132) (cons 46 4.44089e-016) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 2.35619) (cons 43 1.11022e-016) (cons 44 1.85616) (cons 45 -2.12132) (cons 46 4.44089e-016) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 98 1) (cons 10 (list 0.0 0.0 0.0)))) (command "._erase" E01 "") (setenv "MaxHatch" "100") (EARTH_RUS) (princ)) (princ) (princ "\nEARTH.lsp loaded... Type EARTH to start.") ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Degrees To Radians. ; (defun EARTH_DTR (DEG#)(* pi (/ DEG# 180.0))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Radians To Degrees. ; (defun EARTH_RTD (RAD#)(* 180.0 (/ RAD# pi))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Make Layer. ; (defun EARTH_ML (LNAM LCLR LTYP LWGT) (if (null (tblsearch "layer" LNAM)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 LNAM) (cons 70 0) (cons 62 LCLR) (cons 6 LTYP) (cons 290 1) (cons 370 LWGT)))) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Change Program Settings. ; (defun EARTH_CPS () (setq CPS (list 0 1 0 0 0 0)) (mapcar (function setvar)(list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits") CPS) (princ)) (princ) ; ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Restore User Settings. ; (defun EARTH_RUS () (setq *error* TERR) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has completed successfully and will now restore your settings.") (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Error Trap. ; (defun EARTH_ET (ERRORMSG) (command nil nil nil) (if (not (member ERRORMSG '("console break" "Function cancelled"))) (princ (strcat "\nError:" ERRORMSG))) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has encountered a user error!") (princ "\nProgram will now restore your settings and exit.") (terpri) (setq *error* TERR) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// Edited July 31, 2010 by The Buzzard Quote
The Buzzard Posted August 1, 2010 Posted August 1, 2010 (edited) All command calls are eliminated. This is an entmake code all the way. It seems that entmake is worth the trouble. Please enjoy. Earth.lsp ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Main Function. ; ; (defun C:EARTH (/ CL01 CL02 CPS DEG# DLEN E01 HANG HPRP HSCL HWID RAD# PT01 PT02 PT03 PT04 SUS) (setq SUS_LST (list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits" "clayer")) (setq SUS (mapcar 'getvar SUS_LST)) (setq TERR *error*) (setq *error* EARTH_ET) (or H:PRP (setq H:PRP "EARTH")) ;Default Hatch Pattern (or H:WID (setq H:WID 6)) ;Default Hatch Width (or H:SCL (setq H:SCL 6)) ;Default Hatch Scale (or H:ANG (setq H:ANG 45)) ;Default Hatch Angle (setq H:WID (cond ((getint (strcat "\nSpecify hatch width. <"(rtos H:WID 2 0)">: ")))(T H:WID))) (setq H:SCL (cond ((getint (strcat "\nSpecify hatch scale. <"(rtos H:SCL 2 0)">: ")))(T H:SCL))) (setq H:ANG (cond ((getint (strcat "\nSpecify hatch angle. <"(rtos H:ANG 2 0)">: ")))(T H:ANG))) (setq HPRP H:PRP HSCL H:SCL HWID H:WID HANG (EARTH_DTR H:ANG) CL01 (getpoint "\nSpecify first point: ") CL02 (getpoint CL01 "\nSpecify second point: ") RAD# (angle CL01 CL02) DEG# (EARTH_RTD RAD#) DLEN (distance CL01 CL02) CL01 (trans CL01 1 0) CL02 (trans CL02 1 0) PT01 CL01 PT02 (polar PT01 (EARTH_DTR (+ DEG# 0)) DLEN) PT03 (polar PT01 (EARTH_DTR (+ DEG# 270)) HWID) PT04 (polar PT02 (EARTH_DTR (+ DEG# 270)) HWID)) (EARTH_CPS) (EARTH_ML "HATCH" 1 "Continuous" 18) ;Set layer name, color, linetype, & lineweight (setvar "clayer" "HATCH") ;Set HATCH layer current (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 410 "Model") (cons 8 "0") (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 0.0) (cons 38 0.0) (cons 39 0.0) (cons 10 PT01) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 PT02) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 PT04) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 PT03) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 210 (list 0.0 0.0 1.0)))) (setq E01 (entlast)) (entmake (list (cons 0 "HATCH") (cons 100 "AcDbEntity") (cons 67 0) (cons 410 "Model") (cons 8 "HATCH") (cons 100 "AcDbHatch") (cons 10 (list 0.0 0.0 0.0)) (cons 210 (list 0.0 0.0 1.0)) (cons 2 HPRP) (cons 70 0) (cons 71 0) (cons 91 1) (cons 92 1) (cons 93 4) (cons 72 1) (cons 10 PT01) (cons 11 PT02) (cons 72 1) (cons 10 PT02) (cons 11 PT04) (cons 72 1) (cons 10 PT04) (cons 11 PT03) (cons 72 1) (cons 10 PT03) (cons 11 PT01) (cons 97 0) (cons 75 0) (cons 76 1) (cons 52 HANG) (cons 41 HSCL) (cons 77 0) (cons 78 6) (cons 53 0.785398) (cons 43 0.0) (cons 44 0.0) (cons 45 2.22045e-016) (cons 46 2.12132) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 0.785398) (cons 43 -0.397748) (cons 44 0.397748) (cons 45 2.22045e-016) (cons 46 2.12132) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 0.785398) (cons 43 -0.795495) (cons 44 0.795495) (cons 45 2.22045e-016) (cons 46 2.12132) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 2.35619) (cons 43 -0.795495) (cons 44 1.06066) (cons 45 -2.12132) (cons 46 4.44089e-016) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 2.35619) (cons 43 -0.397748) (cons 44 1.45841) (cons 45 -2.12132) (cons 46 4.44089e-016) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 53 2.35619) (cons 43 1.11022e-016) (cons 44 1.85616) (cons 45 -2.12132) (cons 46 4.44089e-016) (cons 79 2) (cons 49 1.5) (cons 49 -1.5) (cons 98 1) (cons 10 (list 0.0 0.0 0.0)))) (entdel E01) (setenv "MaxHatch" "100") (EARTH_RUS) (princ)) (princ) (princ "\nEARTH.lsp loaded... Type EARTH to start.") ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Degrees To Radians. ; (defun EARTH_DTR (DEG#)(* pi (/ DEG# 180.0))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Radians To Degrees. ; (defun EARTH_RTD (RAD#)(* 180.0 (/ RAD# pi))) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Make Layer. ; (defun EARTH_ML (LNAM LCLR LTYP LWGT) (if (null (tblsearch "layer" LNAM)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 LNAM) (cons 70 0) (cons 62 LCLR) (cons 6 LTYP) (cons 290 1) (cons 370 LWGT)))) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Change Program Settings. ; (defun EARTH_CPS () (setq CPS (list 0 1 0 0 0 0)) (mapcar (function setvar)(list "cmdecho" "orthomode" "blipmode" "angbase" "angdir" "aunits") CPS) (princ)) (princ) ; ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Restore User Settings. ; (defun EARTH_RUS () (setq *error* TERR) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has completed successfully and will now restore your settings.") (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// ; ; Error Trap. ; (defun EARTH_ET (ERRORMSG) (command nil nil nil) (if (not (member ERRORMSG '("console break" "Function cancelled"))) (princ (strcat "\nError:" ERRORMSG))) (if SUS (mapcar 'setvar SUS_LST SUS)) (princ "\nEARTH.lsp has encountered a user error!") (princ "\nProgram will now restore your settings and exit.") (terpri) (setq *error* TERR) (princ)) (princ) ; ;///////////////////////////////////////////////////////////////////////////////////////// Edited August 1, 2010 by The Buzzard Quote
alanjt Posted August 1, 2010 Posted August 1, 2010 Occurrences such at the above can generally be attributed to running OSnaps. Quote
The Buzzard Posted August 1, 2010 Posted August 1, 2010 Occurrences such at the above can generally be attributed to running OSnaps. Thanks alan, But I am not setting osnaps although others may have them set. I should have disabled them, But with entmake thats not an issue. I cannot get over the difference in speed to execute the program from start to finish. Its a world of a difference. Quote
alanjt Posted August 1, 2010 Posted August 1, 2010 Thanks alan, But I am not setting osnaps although others may have them set. I should have disabled them, But with entmake thats not an issue. I cannot get over the difference in speed to execute the program from start to finish. Its a worl of a difference.That's what I meant. I know you aren't running them, but that kind of issue screams running OSnaps - never underestimate the power of turning the osnaps off or "_non" before each point input. I'm sure it's a lot faster now. Nice work, I hate dealing with entmake when it comes to hatch. Quote
The Buzzard Posted August 1, 2010 Posted August 1, 2010 That's what I meant. I know you aren't running them, but that kind of issue screams running OSnaps - never underestimate the power of turning the osnaps off or "_non" before each point input. I'm sure it's a lot faster now. Nice work, I hate dealing with entmake when it comes to hatch. I know exactly what you mean, I hate dealing with entmake also when it comes down to certain things, But its worth the trouble in the end. Should have done it in the beginning I afraid to say. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.