Jump to content

Bhatch,use lisp,please help!

liuhaixin88

By liuhaixin88
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

liuhaixin88 Collaborator

liuhaixin88

Posted
Posted

Hello everyone，I need some help.

Use LISP to do this:

HATCH.png

 

1. Specify four points.

2. use"bhatch" in this region.Scale can dynamic.

3. Remove the border.

 

Thank for help me!

Tharwat Grand Master

Tharwat

Posted
Posted (edited)

Try this and let me know .

 

(defun c:Test (/ p a i sc l 1p e pl h gr)
 ;;    Tharwat 10. Apr. 2014         ;;
 (if
   (eq
     4
     (logand 4
             (cdr
               (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER))))
             )
     )
   )
    (alert "Current layer is LOCKED ! Unlock and Try again .")
    (if (setq p (getpoint "\n Specify point < 1 > :"))
      (progn
        (setq a  p
              i  1
              sc 1.0
              l  (cons p l)
        )
        (while (/= (length l) 4)
          (setq
            1p (getpoint
                 p
                 (strcat "\n Next point < "
                         (itoa (setq i (1+ i)))
                         " > :"
                 )
               )
          )
          (setq l (cons 1p l)
                p 1p
          )
        )
        (setq
          e (entmakex
              (append (list '(0 . "LWPOLYLINE")
                            '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline")
                            '(70 . 1)
                            '(90 . 4)
                           )
                      (mapcar '(lambda (u) (cons 10 u)) (cons a l))
              )
            )
        )
        (setq pl (entlast))
        (command "_.-hatch" "S" e "" "P" "ANSI37" 1.0 0.0 "")
        (setq h (entlast))
        (vla-put-AssociativeHatch
          (setq v (vlax-ename->vla-object h))
          :vlax-false
        )
        (entdel e)
        (princ "\n Type [+,-] to change Pattern Scale :")
        (if (not (eq pl h))
          (while (or (eq (car (setq gr (grread t 13 0))) 5)
                     (member (cadr gr) '(43 61 45))
                 )
            (redraw)
            (if (and (eq (car gr) 2)
                     (member (cadr gr) '(43 61 45))
                )
              (vla-put-patternscale
                v
                (if (eq (cadr gr) 45)
                  (progn
                    (if (<= (setq sc (- sc 0.5)) 0.)
                      (setq sc 0.5)
                      sc
                    )
                  )
                  (setq sc (+ sc 0.5))
                )
              )
            )
          )
        )
      )
    )
 )
 (princ)
)(vl-load-com)

Edited by Tharwat
liuhaixin88 Collaborator

liuhaixin88

Posted
  • Author
Posted
Try this and let me know .

(defun c:Test (/ p a i l 1p e)
 ;;    Tharwat 10. Apr. 2014         ;;
 (if
   (eq
     4
     (logand 4
             (cdr
               (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER))))
             )
     )
   )
    (alert "Current layer is LOCKED ! Unlock and Try again .")
    (if (setq p (getpoint "\n Specify first point :"))
      (progn
        (setq a p
              i 1
              l (cons p l)
        )
        (while (/= (length l) 4)
          (setq
            1p (getpoint
                 p
                 (strcat "\n Next point < "
                         (itoa (setq i (1+ i)))
                         " > :"
                 )
               )
          )
          (setq l (cons 1p l)
                p 1p
          )
        )
        (setq
          e (entmakex
              (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                            '(100 . "AcDbPolyline") '(70 . 1) '(90 . 4))
                      (mapcar '(lambda (u) (cons 10 u)) (cons a l))
              )
            )
        )
        (command "_.-hatch" "S" e "" "P" "ANSI37" 1.0 0.0 "")
        (entdel e)
      )
    )
 )
 (princ)
)

 

Beautifully!Thank you!but I want scale dynamic , or use "+"&"－"key to adjust scale. thank you very much!tharwat.

Tharwat Grand Master

Tharwat

Posted
Posted
Beautifully!Thank you!but I want scale dynamic , or use "+"&"－"key to adjust scale. thank you very much!tharwat.

 

You're welcome .

 

I just modified the routine to meet your new requirements .

 

Try it and let me know .

liuhaixin88 Collaborator

liuhaixin88

Posted
  • Author
Posted
You're welcome .

 

I just modified the routine to meet your new requirements .

 

Try it and let me know .

 

 

Thank you,Tharwat, Your codes is always reassuring！ Thanks so much!

 

I'm still a little small request:

Add a option, can use "ANSI31" Bhatch, if choose "ANSI31" , must Adjust the "Angle" and "Scale" (ANSI37 only adjust scale ). "angle" only two kinds, 35 and 135.

BIGAL Grand Master

BIGAL

Posted
Posted

Tharwat if you decide to add more to your code maybe rather than hard code the scale and angle put these in a while that allows you to keep changing till happy a none answer would exit the while.

 

Read the above again the + - would be a good way say 5 or 10 degrees.

 

Now wheres that pop up pick hatch dialouge.

BIGAL Grand Master

BIGAL

Posted
Posted

Here is a list select option for basicly any one wanting to pick from a list, thanks to AlanJt for original code. My menu would be ^c^c^p(load "listselect")(Load "Hatcher")

 

; By Alan H Apr 2014
;select from list box 
; thanks to AlanJT for list select
(setq lst (list "Ansi31" "Ansi32" "Net" "dots"))

(setq lstpick (car (AT:ListSelect
               "Set hatch pattern"
               "Select style"
               10
               10
               "false"
               (vl-sort lst) '<)
            )
            )
)
(princ lstpick)

 


 ;; List Select Dialog (Temp DCL list box selection, based on provided list)
 ;; title - list box title
 ;; label - label for list box
 ;; height - height of box
 ;; width - width of box
 ;; multi - selection method ["true": multiple, "false": single]
 ;; lst - list of strings to place in list box
 ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
(defun AT:ListSelect (title label height width multi lst / fn fo d item f)
 (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
 (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;")
                  (strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
                  (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
                  (strcat "width = " (vl-princ-to-string width) ";")
                  (strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
            )
   (write-line x fo)
 )
 (close fo)
 (new_dialog "list_select" (setq d (load_dialog fn)))
 (start_list "lst")
 (mapcar (function add_list) lst)
 (end_list)
 (setq item (set_tile "lst" "0"))
 (action_tile "lst" "(setq item $value)")
 (setq f (start_dialog))
 (unload_dialog d)
 (vl-file-delete fn)
 (if (= f 1)
   ((lambda (s / i s l)
      (while (setq i (vl-string-search " " s))
        (setq l (cons (nth (atoi (substr s 1 i)) lst) l))
        (setq s (substr s (+ 2 i)))
      )
      (reverse (cons (nth (atoi s) lst) l))
    )
     item
   )
 )
)

Tharwat Grand Master

Tharwat

Posted
Posted

I prepared a video for the following routine but it did uploaded as an image and not as a .gif file .

 

Try this routine and let me know how things going on with you .

 

(defun c:Test (/ *error* dlg p a i l 1p sc e pl h gr rot r)
 ;;    Author : Tharwat Al Shoufi 14. Apr. 2014         ;;
 (defun *error* (msg)
   (if (< id 0)
     (unload_dialog id)
   )
   (if (and d (setq d (findfile d)))
     (vl-file-delete d)
   )
   (if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
     (princ msg)
     (princ (strcat "\nError: " msg))
   )
   (princ)
 )
 ;;                    ;;
 (defun dlg (h / d o id head tail go back)
   (if (and (setq d (vl-filename-mktemp nil nil ".dcl")) (setq o (open d "w")))
     (progn (setq head "test : dialog { label = \"Hatch Control\";"
                  tail ": button { label = \"Exit\"; key = \"esc\"; width = 12; height = 2; fixed_width = true; alignment = centered;
            is_default = true; is_cancel = true;}"
            )
            (if h
              (write-line
                (strcat
                  head ": button { label = \"ANSI37\"; key = \"i37\"; width = 10; height = 2.5;} spacer; "
                  ": button { label = \"ANSI31\"; key = \"i31\"; width = 10; height = 2.5;} spacer; " tail "}"
                 )
                o
              )
              (write-line
                (strcat
                  head ": boxed_column { label = \"Controls\"; : text { label = \"Scale\";}"
                  ": row { : button { label = \"+\"; key = \"isc\"; width = 2;}"
                  ": button { label = \"-\"; key = \"dsc\"; width = 2;}}" "spacer; : text { label = \"Rotation\";}"
                  ": row { : button { label = \"+\"; key = \"iro\"; width = 2;}"
                  ": button { label = \"-\"; key = \"dro\"; width = 2;}}} spacer;" tail "}"
                 )
                o
              )
            )
            (close o)
     )
   )
   (if (or (not d)
           (> 0 (setq id (load_dialog d)))
           (not (new_dialog
                  "test"
                  id
                  ""
                  (if *loc*
                    *loc*
                    '(-1 -1)
                  )
                )
           )
       )
     (progn (if (< id 0)
              (unload_dialog id)
            )
            (if (and d (setq d (findfile d)))
              (vl-file-delete d)
            )
     )
     (progn
       (action_tile "i37" "(setq go \"ANSI37\") (done_dialog)")
       (action_tile "i31" "(setq go \"ANSI31\") (done_dialog)")
       (if (eq *pat* "ANSI37")
         (mapcar '(lambda (u) (mode_tile u 1)) (list "iro" "dro"))
       )
       (action_tile
         "iro"
         "(if (>= (setq rot (+ rot (/ pi 12.))) (+ pi pi))
                              (setq rot (/ pi 12.)) rot)(setq r t *loc* (done_dialog))"
       )
       (action_tile
         "dro"
         "(if (>= (setq rot (- rot (/ pi 12.))) (+ pi pi))
                              (setq rot (/ pi 12.)) rot)(setq r t *loc* (done_dialog))"
       )
       (action_tile "isc" "(setq sc (+ sc 0.5) back t *loc* (done_dialog))")
       (action_tile
         "dsc"
         "(if (<= (setq sc (- sc 0.5)) 0.)(setq sc 0.5) sc)(setq back t *loc* (done_dialog))"
       )
       (action_tile "esc" "(setq back nil r nil)(done_dialog)")
       (start_dialog)
       (unload_dialog id)
       (vl-file-delete d)
     )
   )
   (cond ((and back) (vla-put-patternscale v sc) (vla-update v) (dlg nil))
         ((and r) (vla-put-PatternAngle v rot) (vla-update v) (dlg nil))
         (t nil)
   )
   go
 )
 ;;                        ;;
 (if (eq 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER)))))))
   (alert "Current layer is LOCKED ! Unlock and Try again .")
   (if (and (setq *pat* (dlg t)) (setq p (getpoint "\n Specify point < 1 > :")))
     (progn (setq v   nil
                  a   p
                  i   1
                  sc  1.0
                  rot 0.
                  l   (cons p l)
            )
            (while (/= (length l) 4)
              (setq 1p (getpoint p (strcat "\n Next point < " (itoa (setq i (1+ i))) " > :")))
              (setq l (cons 1p l)
                    p 1p
              )
            )
            (setq e (entmakex
                      (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(70 . 1) '(90 . 4))
                              (mapcar '(lambda (u) (cons 10 u)) (cons a l))
                      )
                    )
            )
            (setq pl (entlast))
            (command "_.-hatch" "S" e "" "P" *pat* 1.0 0.0 "")
            (setq h (entlast))
            (vla-put-AssociativeHatch (setq v (vlax-ename->vla-object h)) :vlax-false)
            (entdel e)
            (if (not (eq pl h))
              (dlg nil)
            )
     )
   )
 )
 (princ)
)
(vl-load-com)

liuhaixin88 Collaborator

liuhaixin88

Posted
  • Author
Posted
Here is a list select option for basicly any one wanting to pick from a list, thanks to AlanJt for original code. My menu would be ^c^c^p(load "listselect")(Load "Hatcher")

 

 

Thank you,BIGAL,Thank you for your suggestion!

liuhaixin88 Collaborator

liuhaixin88

Posted
  • Author
Posted
I prepared a video for the following routine but it did uploaded as an image and not as a .gif file .

 

Try this routine and let me know how things going on with you .

 

 

Thank you very much, Tharwat,

 

Perfect code. You're the greatest!

Tharwat Grand Master

Tharwat

Posted
Posted
Thank you very much, Tharwat,

 

Perfect code. You're the greatest!

 

Excellent , you are welcome anytime . :)

  • 3 weeks later...
andy_lee Collaborator

andy_lee

Posted
Posted
I prepared a video for the following routine but it did uploaded as an image and not as a .gif file .

 

Try this routine and let me know how things going on with you .

 

 
Nice to see you again ,Tharwat, Can you extend to me, please！
 
I don't need pick 4 point to hatch, only pick one point, like Internal command: bhatch , I only need ANSI131 & ANSI137 too.

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...