Polyline and hatching with AutoLISP

[Mohammad Ramdan Purnama]

Hello everyone,

I want to create a program that draws a polyline with hatching and hatching scale, here is the script:

(defun kb_sc (/ sc_ent sc_sc)



  ; select area

  (command "_pline")

  (setq sc_ent (entlast))



  ; scale

  (princ "\nEnter scale:")

  (setq sc_sc (getint))



  ; hatching

  (setq oldHPNAME (getvar "HPNAME"))

  (setq oldHPSCALE (getvar "HPSCALE"))



  (setvar "HPNAME" "ANSI31")

  (setvar "HPSCALE" sc_sc)



  (command "-HATCH" "S" sc_ent "" "")



  (setvar "HPNAME" oldHPNAME)

  (setvar "HPSCALE" oldHPSCALE)

)

 

However, there is a problem. Can you provide a solution so that this program can run properly?

 

Thank You

Edited March 16, 2023 by SLW210
Added Code Tags!

[marko_ribar]

I've made it more readable and improved coding, but haven't tested...

Tell us how it passed test(s)...

 

(defun c:kb_sc ( / *error* sc_ent sc_sc oldhpname oldhpscale )

  (vl-load-com) ; enable VisualLisp extensions

  ; error handler
  (defun *error* ( m )
    (if oldhpname
      (setvar (quote hpname) oldhpname)
    )
    (if oldhpscale
      (setvar (quote hpscale) oldhpscale)
    )
    (if m
      (prompt m)
    )
    (princ)
  )

  ; select area
  (command "_.PLINE")
  (while (< 0 (getvar (quote cmdactive)))
    (command "\\")
  )
  (setq sc_ent (entlast))
  (if (not (vlax-curve-isclosed sc_ent))
    (vla-put-closed (vlax-ename->vla-object sc_ent) :vlax-true)
  )
  ; scale
  (initget 7)
  (setq sc_sc (getdist "\nPick or specify scale : "))
  ; hatching
  (setq oldhpname (getvar (quote hpname)))
  (setq oldhpscale (getvar (quote hpscale)))
  (setvar (quote hpname) "ANSI31")
  (setvar (quote hpscale) sc_sc)
  (command "_.HATCH" "_S" sc_ent "" "")
  (*error* nil)
)

 

HTH.

M.R.

Edited March 16, 2023 by marko_ribar

[Steven P]

Yup, a quick description of the problem would help

[Emmanuel Delay]

I found this code here

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/m-p/8703197#M383362

 

I adapted it to do what you asked.

I made 2 commands: 1 that selects existing polylines ( SPH ), 1 where you make new polylines ( MPH ).

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; https://www.cadtutor.net/forum/topic/77129-polyline-and-hatching-with-autolisp/
				 
;; User makes a polyline by selecting points.  The polyline is auto closed, a hatch is drawn inside
;; Make Polyline Hatch
(defun c:mph ( / ss sc pp pt pts ln ls pline)
	(setq sc (getreal "\nScale: "))
	(if (= 0.0 sc)
		(setq sc 1.0)
	)
	(prompt "\nSelect points to make a Closed Polyline.  Press enter to close the polyline: ")
	(setq pts (list))
	(setq ls (list))
	(setq pt (getpoint "\nPoint 1: "))
	(setq pp pt)
	(setq pts (append pts (list pt)))
	(while (setq pt (getpoint pt "\nPoint: "))
		;; draw temporary line
		(setq ls (append ls (list (drawLine pp pt))))
		(setq pp pt)
		(setq pts (append pts (list pt)))
	)
	(setq pline (drawLWPoly pts 1))
	;; delete temporary lines
	(foreach ln ls
		(entdel ln)
	)
	
	(hatch_closed_polyline (ssadd pline) sc)
)

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
(defun drawLine (p1 p2)
 (entmakex (list (cons 0 "LINE")
                 (cons 10 p1)
                 (cons 11 p2)))
)

(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)))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; user selects existing polylines; a hatch will be drawn inside 

;; Select Polyline Hatch
(defun c:sph ( / ss sc)
	(setq sc (getreal "\nScale: "))
	(prompt "\nSelect Closed Polylines to Hatch: ")
	(while (setq ss (ssget '((0 . "LWPOLYLINE"))))
		(hatch_closed_polyline ss sc)
		;;(entmakex-hatch hList 0.0 "ANSI31" 1.0)
	)
)

;; slightly modified from this code:
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/entmake-hatch-with-base-point-or-object-polyline-entity-name/m-p/8703197#M383362
 
(defun hatch_closed_polyline (ss sc /  cnt e hList)

	(if (= 0.0 sc)
		(setq sc 1.0)
	)
	
(setq cnt (sslength ss))
(while (<= 0 (setq cnt (1- cnt)))
  (setq e (ssname ss cnt))
  (if (setq tmp (CreateHatchList e))
    (setq hList (cons tmp hList))
  );if
);while
(setq hList (reverse hList))
(if (entmakex-hatch hList 0.0 "ANSI31" sc)
  (prompt "\nSuccess!")
  (prompt "\n...Failure.")
);if
(princ)
);defun

(defun CreateHatchList (e / i j pList found)
(foreach i (entget e)
  (if (= 10 (car i))
    (progn
      (setq pList (cons i pList))
      (setq found nil j (member i (entget e)))
      (while (and (not found) (< 0 (length j)))
	(if (= 42 (car (car j)))
	  (setq pList (cons (car j) pList) found t)
	);if
	(setq j (cdr j))
      );while
    );progn
  );if
);foreach
(reverse pList)
);defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun entmakex-hatch (l a n s)
 ;; By ElpanovEvgeniy
 ;; L - list point
 ;; A - angle hatch
 ;; N - name pattern
 ;; S - scale
 ;; return - hatch ename
 (entmakex
  (apply
   'append
   (list
    (list '(0 . "HATCH") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbHatch")
          '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0)
          (cons 2 n)
          (if (= n "SOLID")
           '(70 . 1)
           '(70 . 0)
          ) ;_  if
          '(71 . 0)
          (cons 91 (length l))
    ) ;_  list
    (apply 'append
           (mapcar '(lambda (a)
                     (apply 'append
                            (list (list '(92 . 7) '(72 . 1) '(73 . 1) (cons 93 (/ (length a) 2)))
				  (mapcar '(lambda (b) b) a)
                                  '((97 . 0))
                            ) ;_  list
                     ) ;_  apply
                    ) ;_  lambda
                   l
           ) ;_  mapcar
    ) ;_  apply
    (list '(75 . 0) '(76 . 1) (cons 52 a) (cons 41 s) '(77 . 0) '(78 . 1) (cons 53 a)
          '(43 . 0.) '(44 . 0.) '(45 . 1.) '(46 . 1.) '(79 . 0) '(47 . 1.) '(98 . 2)
          '(10 0. 0. 0.0) '(10 0. 0. 0.0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 1)
          '(462 . 1.0) '(453 . 2) '(463 . 0.0) '(463 . 1.0) '(470 . "ANSI31")
    ) ;_  list
   ) ;_  list
  ) ;_  apply
 ) ;_  entmakex
) ;_  defun


(princ "\nCOMMAND MPH: Make Polyline Hatch.")
(princ "\nCOMMAND SPH: Select Polyline Hatch.")
(princ)

 

[thekiki]

Hi Emmanuel,

Thank you for this lisp. In the second lisp (sph), instead of selecting the polylines,

i don't know if we can selected only one polyline and the others polylines (included circles..) which have the SAME LAYER do the same job!

Sorry for my english!

Many thanks!

[Emmanuel Delay]

Circle won't work.  The code asks for a point list; so nothing round.

It will work for all closed polylines.

Add this to the rest of my previous code

 

;; Select Polyline Hatch Layer
;; user selects an object.  All closed polylines on the layer of the 
;;    selected object gets selected and a hatch is drawn inside

(defun c:sphl ( / obj layer ss sc i)
	(setq sc (getreal "\nScale: "))
	(prompt "\nSelect Closed Polylines to Hatch. All closed polylines on the layer of the selected object \ngets selected and a hatch is drawn inside: ")
	(setq obj (car (entsel "\nSelect object: ")))
	(setq layer (cdr (assoc 8 (entget obj))))
	(setq ss (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 70 1) (cons 8 layer) )))
	(setq i 0)
	(repeat (sslength ss)
		(hatch_closed_polyline (ssadd (ssname ss i)) sc)
		(setq i (+ i 1))
	)
)

 

[thekiki]

It's seems working. Many thanks!

[thekiki]

It's OK for "ANSI31" pattern. Is it possible to do that for the pattern by default (pattern, angle, scale..by default)?

Many thanks!

[Emmanuel Delay]

Try this:

 

replace (don't forget the ')

'(470 . "ANSI31")
by
(cons 470 (getvar "HPNAME"))

[thekiki]

Sorry, I can't see the line to be replaced?!

[Steven P]

It is at the end of here:

find' would get that.

Just replace the part shown

 

(list '(75 . 0) '(76 . 1) (cons 52 a) (cons 41 s) '(77 . 0) '(78 . 1) (cons 53 a)
          '(43 . 0.) '(44 . 0.) '(45 . 1.) '(46 . 1.) '(79 . 0) '(47 . 1.) '(98 . 2)
          '(10 0. 0. 0.0) '(10 0. 0. 0.0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 1)
          '(462 . 1.0) '(453 . 2) '(463 . 0.0) '(463 . 1.0) '(470 . "ANSI31")

 

[thekiki]

It seems not working. Error! Can you please put it together.

thanks!

[thekiki]

For Emmanuel, i replace '(470 . "ANSI31")by (cons 470 (getvar "HPNAME")), it seems to be like before that's to say "ANSI 31" pattern and not model hatching by default.

For Steven P, i replace (list '(75 . 0) '(76 . 1) (cons 52 a) (cons 41 s) '(77 . 0) '(78 . 1) (cons 53 a) '(43 . 0.) '(44 . 0.) '(45 . 1.) '(46 . 1.) '(79 . 0) '(47 . 1.) '(98 . 2) '(10 0. 0. 0.0) '(10 0. 0. 0.0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 1) '(462 . 1.0) '(453 . 2) '(463 . 0.0) '(463 . 1.0) '(470 . "ANSI31") and the result is error!

Any help would be appreciated!