Dirt / Soil Hatch LISP

August 1, 2010

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.

It always pays off. With hatch, I take the easier route and use VL.

August 1, 2010

It always pays off. With hatch, I take the easier route and use VL.

Here we go! VL this and VL that! I do admit I like a VLT. Vacon, Lettuce and Tomato.

August 1, 2010

Here we go! VL this and VL that! I do admit I like a VLT. Vacon, Lettuce and Tomato.

Don't get me wrong, entmake is awesome in so many ways. There's just a few things I prefer VL for. Text and blocks especially, since I don't want to lose out on annotative scales.

August 1, 2010

Don't get me wrong, entmake is awesome in so many ways. There's just a few things I prefer VL for. Text and blocks especially, since I don't want to lose out on annotative scales.

Thats OK Alan, I think you know me well enough by now that I can be a chop breaker, But its all in fun just the same and nothing meant as a spitball to to you. I am just stuck in may old ways.

August 1, 2010

Thats OK Alan, I think you know me well enough by now that I can be a chop breaker, But its all in fun just the same and nothing meant as a spitball to to you. I am just stuck in may old ways.

Oh I know. I get a kick out it it.

I'm just lazy.

August 1, 2010

Just out of curiosity, It would be interesting to see a VL code that does the same thing here for comparison as to how it would be written. It could be helpful to me as well as others if they decide to go down that road. I will leave that up to you. Its not real important although it would be again very interesting.

Edited August 1, 2010 by The Buzzard

August 1, 2010

Hey guys sorry I disappeared there.

At this new work place it seems if you visit a website too much it blocks it ! Argh IT stuff.

Anyway I've been seeing the auto response e-mails come through but not being able to read the replies

Thank you very much for all the replies and help !

It's exactly what I wanted

Very very very much appreciated !!!

August 1, 2010

Hey guys sorry I disappeared there.
At this new work place it seems if you visit a website too much it blocks it ! Argh IT stuff.

Anyway I've been seeing the auto response e-mails come through but not being able to read the replies

Thank you very much for all the replies and help !

It's exactly what I wanted

Very very very much appreciated !!!

Your welcome, Just make sure you use the lisp in post 16. Thats the one with all the bugs removed.

If you need help editing it to your liking, Please mention.

August 2, 2010

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)
;
;/////////////////////////////////////////////////////////////////////////////////////////

Great codes BUZZARD. I did like the entmake that you used in your routine.

I wish I could be that helpful one day, as best as you.

Best Regards,

Tharwat

August 2, 2010

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)
;
;/////////////////////////////////////////////////////////////////////////////////////////

dear sir

great this lisp working

solve my problem thx for help

August 2, 2010

Thanks, But I am still learning myself,

You will get there in your time. All you need to do is keep asking questions and study whats put in front of you. Also experiment often, This helps to see how much more you can do with the knowledge you gain. Do not wait for it to come to you or someone to do it for you. You will be surprised how much you can learn by taking someones code apart and try to use it in another way.

August 2, 2010

Yes . Wonderful ....

I do agree with you completely. And you know, getting ready codes on a tray, that's a matter of failure users.

Thanks a lot.

Tharwat

August 2, 2010

Yes . Wonderful ....

I do agree with you completely. And you know, getting ready codes on a tray, that's a matter of failure users.

Thanks a lot.

Tharwat

I would prefer to see others learn how to do their own codes, But its not good to be that critical if they decide not to. Afterall nobody can press you to do it for them. Do it for people if you want to, But make sure you establish your limits as to how far you are willing to go if it seems others expect it from you or just don't do it at all. Its not worth ruining your day over it.

August 2, 2010

But its not good to be that critical if they decide not to. .

Yes. you are right, And I am sorry for that.

Beside that, I had a very strong base with Lisp when you helped me out with your program ELBOW 45.lsp and spent that much

time on it, I really can not forget it at all.

I Highly appreciate your way of helping the others.

Thanking you.

Sign In

Dirt / Soil Hatch LISP

Recommended Posts

alanjt

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

The Buzzard

alanjt

The Buzzard

alanjt

The Buzzard

RockyMarc

The Buzzard

Tharwat

autolisp

The Buzzard

Tharwat

The Buzzard

Tharwat

Join the conversation

Tutorials

Forums

Activity