Topic: Hatch area with 2 picks

[GDF]

Anyone have a routine that will hatch an area with only two picks?
The hatch area would be 5'-0" perpendicular from each side of the hatch area
centerline <see image>.
--

Gary

[nivuahc]

shouldn't be too difficult to write sonething Gary. I don't have AutoCAD at my disposal so I'd be running on "I think this is what you need" and I don't have enough faith in my memory to do that.

[nivuahc]

This is how I would do it, off the top of my head, in pseudo-code:

Code: [Select]

get the two points
calculate the offsets
draw a closed polygon boundary
select the boundary
hatch it
should be simple enough

[CAB]

Gary
Here is a start.

Code: [Select]

(defun c:myhatch (/ ang dist hscale p1 p2 rb usercmd useros rtd)
  (defun rtd (r) (* 180.0 (/ r pi)))
  (setq usercmd (getvar "CMDECHO")
        useros  (getvar "osmode")
        dist    60  ; 5' distance
        hscale  100 ; Hatch Scale
        rb      "Y" ; retain border
  )
  (setvar "CMDECHO" 0)
  (setq p1 (getpoint "\nPick first point of Centerline."))
  (setq p2 (getpoint p1 "\nPick second point of Centerline."))
  (setq ang (angle p1 p2))
  (setvar "osmode" 0)
  (command "_.hatch" "ANSI31" hscale (rtd ang) "" rb
           (polar p1  (+ ang (* pi 0.5)) dist)
           (polar p2  (+ ang (* pi 0.5)) dist)
           (polar p2  (- ang (* pi 0.5)) dist)
           (polar p1  (- ang (* pi 0.5)) dist)
           "close" ""
          )
  (setvar "CMDECHO" usercmd)
  (setvar "osmode" useros)
  (princ)
)

[Jeff_M]

Here's one using ActiveX....

Code: [Select]

(defun c:2phatch (/ a ang b c coords d dist doc hatch pline pt1 pt2 space)
  (vl-load-com)
  (while (and (setq pt1 (getpoint "\nFirst point: "))
      (setq pt2 (getpoint pt1 "......second point: "))
      )
    (setq ang (angle pt1 pt2)
  dist (if (or (= 3 (getvar "lunits"))
       (= 4 (getvar "lunits"))
       )
60.0
5.0)
  )
    (setq a (polar pt1 (+ ang (/ pi 2)) dist)
  d (polar pt1 (- ang (/ pi 2)) dist)
  b (polar pt2 (+ ang (/ pi 2)) dist)
  c (polar pt2 (- ang (/ pi 2)) dist)
  )
    (setq coords (apply 'append (mapcar '(lambda (x)
    (list (car x) (cadr x))
    )
(list a b c d)
)))
    (setq doc (vla-get-activedocument (vlax-get-acad-object))
  space (if (= 1 (getvar "cvport"))
  (vla-get-paperspace doc)
  (vla-get-modelspace doc)
  )
  pline (vlax-invoke space 'addlightweightpolyline coords)
  )
    (vla-put-closed pline :vlax-true)
    (setq hatch (vlax-invoke space 'addhatch acHatchPatternTypePredefined "ANSI31" :vlax-false))
    (vlax-invoke hatch 'appendouterloop (list pline))
    (vlax-put hatch 'patternangle ang)
    (vlax-put hatch 'patternscale (getvar "hpscale"))
    (vlax-invoke hatch 'evaluate)
    )
  (princ)
  )

[GDF]

Thanks eveyone. I was just too lazy to even start one. Jeff and Allen, both work great.
Thanks. You saved me a lot of time.

Gary