;;; Create closed area Hatch already drawn by polyline with option to edit alredy created hatch dynamicly
;;; Modified by Igal Averbuh 2017
;;; Based on Marko Ribar routine published here: http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/2-click-solid-hatch/td-p/6055800
;;; end other developers subroutines with respect to them

(defun c:dhe ( / *error* GetHatchNames Sel Ent EntData oData nStyle BasePt HatchList Pos
TogAngle tempList tempPt tempData )

(defun *error* ( msg )

(vl-bt)
(if oData (entmake oData))
(if Ent (entdel Ent))
(if msg (prompt (strcat "\n Error-> " msg)))
(redraw)
)
;--------------------------------
(defun GetHatchNames ( filePath / Opened tempStr tempPos tempName HatchList )

(if (setq Opened (open filePath "r"))
(while (setq tempStr (read-line Opened))
(if
(and
(= (substr tempStr 1 1) "*")
(setq tempPos (vl-string-search "," tempStr))
(setq tempName (substr tempStr 2 (1- tempPos)))
(/= (strcase tempName) "SOLID")
)
(setq HatchList (cons tempName HatchList))
)
)
)
(if Opened (close Opened))
(reverse HatchList)
)
;------------------------------------
(if
(and
(setq Sel (entsel "\nSelect just created hatch to edit it dynamicly: "))
(setq oData (entget (car Sel)))
(= (cdr (assoc 0 oData)) "HATCH")
(setq nStyle (cdr (assoc 2 oData)))
(setq BasePt (cadr Sel))
(setq HatchList (GetHatchNames (findfile "acad.pat")))
(setq Pos (vl-position nStyle HatchList))
(setq TogAngle 0)
)
(while
(and
(not
(prompt
(strcat
"\r Current style: "
nStyle
" , Allow angle change: "
(if (zerop TogAngle) "No" "Yes")
" [Style / Angle toggle]: "
)
)
)
(setq tempList (grread T 11))
(not (equal (car tempList) 3))
)
(or
Ent
(setq Ent (car Sel))
)
(setq EntData (entget Ent '("*")))
(cond
( (equal (car tempList) 5)
(setq tempPt (cadr tempList))
(redraw)
(grdraw BasePt tempPt 7)
(setq tempData
(subst
(cons
41
(distance tempPt BasePt)
;(/ (distance tempPt BasePt) (/ (getvar 'ViewSize) 5.))
)
(assoc 41 EntData)
EntData
)
)
(if (equal TogAngle 1)
(setq tempData
(subst
(cons 52 (angle BasePt tempPt))
(assoc 52 EntData)
tempData
)
)
)
(if (entmake tempData)
(progn
(entdel Ent)
(setq Ent (entlast))
)
)
)
((equal (car tempList) 2)
(cond
( (member (cadr tempList) '(83 115))
(setq nStyle (nth (setq Pos (1+ Pos)) HatchList))
(if (entmake
(subst
(cons 2 nStyle)
(assoc 2 EntData)
EntData
)
)
(progn
(entdel Ent)
(setq Ent (entlast))
)
)
)
( (member (cadr tempList) '(65 97))
(setq TogAngle (abs (1- TogAngle)))
)
)
)
)
)
)
(redraw)
(princ)
)

(defun c:phx ( / hpn )
(setq hpn (getvar 'hpname))
(setvar 'hpname "ANSI37")
(setvar "osmode" 167)
(setq sc (getdist "\nSet Initial Hatch Scale: "))
(command "_.pline")
(while (< 0 (getvar 'cmdactive)) (command "\\"))
(command "_.-BHATCH" "P" "" sc "" "_S" (ssadd (entlast)))
(while (< 0 (getvar 'cmdactive)) (command ""))
(setvar 'hpname hpn)
(princ)
(command "_.change" "L" "" "P" "C" "Bylayer" "")
)

(defun c:ph ( /)
(c:phx)
(c:dhe)
)
(c:ph)

Advertisements