Jump to content

Draw a triangle and hatch

DuanJinHui

By DuanJinHui
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

DuanJinHui Collaborator

DuanJinHui

Posted
Posted

Hello. Cadtutor's friends

I have an idea, want to use lisp to do these things. Someone can help me ?

 

1.Enter the length of "L" , Then Pick up two perpendicular lines ,maybe is Plines.

Draw a isosceles triangle, and hatch.

eg.

TEST1.gif

 

2. Enter the length of "L" , Then Pick up two perpendicular lines ,maybe is Plines.

 

Draw a right triangle, and hatch.

eg. Maybe need to choose which side .

TEST2.gif

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

Welcome to CADTutor :)

 

Try this routine , and press TAB button to step through triangle shapes .

 

(defun c:Test (/ *error* i a b c hp gr e p)
 ;;    Tharwat Al Shoufi    ;;
 ;;    Date: 31.08.2014    ;;
 ;;    Dynamic Triangle     ;;
 (defun *error* (msg)
   (redraw)
   (if hp
     (setvar 'HPNAME hp)
   )
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ (strcat "\n** Error: " msg " **"))
   )
 )
 (if
   (and (setq
          *length* (cond
                     ((getdist (strcat "\n Specify Length of triangle <"
                                       (rtos (cond (*length*)
                                                   ((setq *length* 1.0))
                                             )
                                             2
                                             2
                                       )
                                       ">: "
                               )
                      )
                     )
                     (*length*)
                   )
        )
        (setq p (getpoint "\n Specify base point :"))
   )
    (progn
      (setq hp (getvar 'HPNAME)
            i  1
            a  (polar p 0. (/ *length* 2.))
            b  (polar a pi *length*)
            c  (polar p (* pi 0.5) *length*)
      )
      (grvecs (list -3 a b b c c a))
      (princ "\n Press TAB to step into shapes :")
      (while (eq (cadr (setq gr (grread nil 14 0))) 9)
        (redraw)
        (if (eq (cadr gr) 9)
          (cond ((eq i 0)
                 (setq a (polar p 0. (/ *length* 2.))
                       b (polar a pi *length*)
                       c (polar p (* pi 0.5) *length*)
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 1)
                 (setq a (polar p 0. *length*)
                       b (polar p (* pi 0.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 2)
                 (setq a (polar p 0. *length*)
                       b (polar p (* pi 1.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 3)
                 (setq a (polar p pi (/ *length* 2.))
                       b (polar a 0. *length*)
                       c (polar p (* pi 1.5) *length*)
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 4)
                 (setq a (polar p pi *length*)
                       b (polar p (* pi 1.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 5)
                 (setq a (polar p pi *length*)
                       b (polar p (* pi 0.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )

          )
        )
        (if (eq i 5)
          (setq i 0)
          (setq i (1+ i))
        )
      )
      (if (or (member (car gr) '(3 25)) (member (cadr gr) '(32 13)))
        (if (setq e (entmakex
                      (list '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline")
                            '(90 . 3)
                            '(70 . 1)
                            (cons 10 a)
                            (cons 10 b)
                            (cons 10 c)
                      )
                    )
            )
          (progn
            (setvar 'HPNAME "SOLID")
            (command "_.-hatch" "S" e "" "")
          )
        )
      )
    )
 )
 (*error* nil)
 (princ)
)

Link to comment
Share on other sites
DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted
Welcome to CADTutor :)

 

Try this routine , and press TAB button to step through triangle shapes .

 

(defun c:Test (/ *error* i a b c hp gr e p)
 ;;    Tharwat Al Shoufi    ;;
 ;;    Date: 31.08.2014    ;;
 ;;    Dynamic Triangle     ;;
 (defun *error* (msg)
   (redraw)
   (if hp
     (setvar 'HPNAME hp)
   )
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ (strcat "\n** Error: " msg " **"))
   )
 )
 (if
   (and (setq
          *length* (cond
                     ((getdist (strcat "\n Specify Length of triangle <"
                                       (rtos (cond (*length*)
                                                   ((setq *length* 1.0))
                                             )
                                             2
                                             2
                                       )
                                       ">: "
                               )
                      )
                     )
                     (*length*)
                   )
        )
        (setq p (getpoint "\n Specify base point :"))
   )
    (progn
      (setq hp (getvar 'HPNAME)
            i  1
            a  (polar p 0. (/ *length* 2.))
            b  (polar a pi *length*)
            c  (polar p (* pi 0.5) *length*)
      )
      (grvecs (list -3 a b b c c a))
      (princ "\n Press TAB to step into shapes :")
      (while (eq (cadr (setq gr (grread nil 14 0))) 9)
        (redraw)
        (if (eq (cadr gr) 9)
          (cond ((eq i 0)
                 (setq a (polar p 0. (/ *length* 2.))
                       b (polar a pi *length*)
                       c (polar p (* pi 0.5) *length*)
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 1)
                 (setq a (polar p 0. *length*)
                       b (polar p (* pi 0.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 2)
                 (setq a (polar p 0. *length*)
                       b (polar p (* pi 1.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 3)
                 (setq a (polar p pi (/ *length* 2.))
                       b (polar a 0. *length*)
                       c (polar p (* pi 1.5) *length*)
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 4)
                 (setq a (polar p pi *length*)
                       b (polar p (* pi 1.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )
                ((eq i 5)
                 (setq a (polar p pi *length*)
                       b (polar p (* pi 0.5) *length*)
                       c p
                 )
                 (grvecs (list -3 a b b c c a))
                )

          )
        )
        (if (eq i 5)
          (setq i 0)
          (setq i (1+ i))
        )
      )
      (if (or (member (car gr) '(3 25)) (member (cadr gr) '(32 13)))
        (if (setq e (entmakex
                      (list '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline")
                            '(90 . 3)
                            '(70 . 1)
                            (cons 10 a)
                            (cons 10 b)
                            (cons 10 c)
                      )
                    )
            )
          (progn
            (setvar 'HPNAME "SOLID")
            (command "_.-hatch" "S" e "" "")
          )
        )
      )
    )
 )
 (*error* nil)
 (princ)
)

 

Mr.Tharwat. Thanks for your help. But, maybe like this, how to handle ?

T.gif

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted
Mr.Tharwat. Thanks for your help. But, maybe like this, how to handle ?

 

Not a problem at all , try the modification and let me know ;)

 

(defun c:Test (/ *error* i a b c hp gr e p p1 ang)
 ;;    Tharwat Al Shoufi	;;
 ;;    Date: 31.08.2014	;;
 ;;    Dynamic Triangle	;;
 ;;	Resision - 01 Direction	;;
 ;;	of triangle added	;;
 (defun *error* (msg)
   (redraw)
   (if hp
     (setvar 'HPNAME hp)
   )
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ (strcat "\n** Error: " msg " **"))
   )
 )
 (if (and (setq *length* (cond ((getdist (strcat "\n Specify Length of triangle <"
                                                 (rtos (cond (*length*)
                                                             ((setq *length* 1.0))
                                                       )
                                                       2
                                                       2
                                                 )
                                                 ">: "
                                         )
                                )
                               )
                               (*length*)
                         )
          )
          (setq p (getpoint "\n Specify base point :"))
          (setq p1 (getpoint "\n Specify Direction :" p))
     )
   (progn (setq hp  (getvar 'HPNAME)
                i   1
                ang (angle p p1)
                a   (polar p (+ ang (* pi 1.5)) (/ *length* 2.))
                b   (polar p (+ ang (* pi 0.5)) (/ *length* 2.))
                c   (polar p ang *length*)
          )
          (grvecs (list -3 a b b c c a))
          (princ "\n Press TAB to step into shapes :")
          (while (eq (cadr (setq gr (grread nil 14 0))) 9)
            (redraw)
            (if (eq (cadr gr) 9)
              (cond ((eq i 0)
                     (setq a (polar p (+ ang (* pi 1.5)) (/ *length* 2.))
                           b (polar p (+ ang (* pi 0.5)) (/ *length* 2.))
                           c (polar p ang *length*)
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 1)
                     (setq a (polar p (+ ang (* pi 1.5)) *length*)
                           b (polar p ang *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 2)
                     ;;			;;
                     (setq a (polar p (+ ang (* pi 1.5)) *length*)
                           b (polar p (+ ang pi) *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 3)
                     ;;			;;
                     (setq a (polar p (+ ang (* pi 1.5)) (/ *length* 2.))
                           b (polar a (+ ang (* pi 0.5)) *length*)
                           c (polar p (+ ang pi) *length*)
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 4)
                     ;;			;;
                     (setq a (polar p (+ ang (* pi 0.5)) *length*)
                           b (polar p (+ ang pi) *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 5)
                     ;;			;;
                     (setq a (polar p ang *length*)
                           b (polar p (+ ang (* pi 0.5)) *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
              )
            )
            (if (eq i 5)
              (setq i 0)
              (setq i (1+ i))
            )
          )
          (if (and (or (member (car gr) '(3 25)) (member (cadr gr) '(32 13)))
                   (setq e (entmakex (list '(0 . "LWPOLYLINE")
                                           '(100 . "AcDbEntity")
                                           '(100 . "AcDbPolyline")
                                           '(90 . 3)
                                           '(70 . 1)
                                           (cons 10 a)
                                           (cons 10 b)
                                           (cons 10 c)
                                     )
                           )
                   )
              )
            (progn (setvar 'HPNAME "SOLID") (command "_.-hatch" "S" e "" ""))
          )
   )
 )
 (*error* nil)
 (princ)
)

Link to comment
Share on other sites
DuanJinHui Collaborator

DuanJinHui

Posted
  • Author
Posted
Not a problem at all , try the modification and let me know ;)

 

(defun c:Test (/ *error* i a b c hp gr e p p1 ang)
 ;;    Tharwat Al Shoufi	;;
 ;;    Date: 31.08.2014	;;
 ;;    Dynamic Triangle	;;
 ;;	Resision - 01 Direction	;;
 ;;	of triangle added	;;
 (defun *error* (msg)
   (redraw)
   (if hp
     (setvar 'HPNAME hp)
   )
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ (strcat "\n** Error: " msg " **"))
   )
 )
 (if (and (setq *length* (cond ((getdist (strcat "\n Specify Length of triangle <"
                                                 (rtos (cond (*length*)
                                                             ((setq *length* 1.0))
                                                       )
                                                       2
                                                       2
                                                 )
                                                 ">: "
                                         )
                                )
                               )
                               (*length*)
                         )
          )
          (setq p (getpoint "\n Specify base point :"))
          (setq p1 (getpoint "\n Specify Direction :" p))
     )
   (progn (setq hp  (getvar 'HPNAME)
                i   1
                ang (angle p p1)
                a   (polar p (+ ang (* pi 1.5)) (/ *length* 2.))
                b   (polar p (+ ang (* pi 0.5)) (/ *length* 2.))
                c   (polar p ang *length*)
          )
          (grvecs (list -3 a b b c c a))
          (princ "\n Press TAB to step into shapes :")
          (while (eq (cadr (setq gr (grread nil 14 0))) 9)
            (redraw)
            (if (eq (cadr gr) 9)
              (cond ((eq i 0)
                     (setq a (polar p (+ ang (* pi 1.5)) (/ *length* 2.))
                           b (polar p (+ ang (* pi 0.5)) (/ *length* 2.))
                           c (polar p ang *length*)
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 1)
                     (setq a (polar p (+ ang (* pi 1.5)) *length*)
                           b (polar p ang *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 2)
                     ;;			;;
                     (setq a (polar p (+ ang (* pi 1.5)) *length*)
                           b (polar p (+ ang pi) *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 3)
                     ;;			;;
                     (setq a (polar p (+ ang (* pi 1.5)) (/ *length* 2.))
                           b (polar a (+ ang (* pi 0.5)) *length*)
                           c (polar p (+ ang pi) *length*)
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 4)
                     ;;			;;
                     (setq a (polar p (+ ang (* pi 0.5)) *length*)
                           b (polar p (+ ang pi) *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
                    ((eq i 5)
                     ;;			;;
                     (setq a (polar p ang *length*)
                           b (polar p (+ ang (* pi 0.5)) *length*)
                           c p
                     )
                     (grvecs (list -3 a b b c c a))
                    )
              )
            )
            (if (eq i 5)
              (setq i 0)
              (setq i (1+ i))
            )
          )
          (if (and (or (member (car gr) '(3 25)) (member (cadr gr) '(32 13)))
                   (setq e (entmakex (list '(0 . "LWPOLYLINE")
                                           '(100 . "AcDbEntity")
                                           '(100 . "AcDbPolyline")
                                           '(90 . 3)
                                           '(70 . 1)
                                           (cons 10 a)
                                           (cons 10 b)
                                           (cons 10 c)
                                     )
                           )
                   )
              )
            (progn (setvar 'HPNAME "SOLID") (command "_.-hatch" "S" e "" ""))
          )
   )
 )
 (*error* nil)
 (princ)
)

 

dear sir, nice program. perfect. Thank you so much!

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...