Unassociative Hatch to Associative

Discussion in 'AutoCAD' started by Josh Limas, Oct 7, 2004.

  1. Josh Limas

    Josh Limas Guest

    Does anybody know how to convert the existing unassociative hatch to
    associative?  I'm using r2000.  Thanks.
     
    Josh Limas, Oct 7, 2004
    #1
  2. Josh Limas

    Paul Turvill Guest

    Erase the hatch and re-hatch. An associative hatch includes its bounding
    objects; once it's made non-associative there's no way to tell it which
    objects to "associate" with.
    ___
     
    Paul Turvill, Oct 7, 2004
    #2
  3. Josh Limas

    3ABTPA Guest

    Don't do that; you will take the benefit of associative hatch feature
    (stretch) and you will, some day, loose your drawing
     
    3ABTPA, Oct 7, 2004
    #3
  4. Josh Limas

    Josh Limas Guest

    I'm aware of the benefit I'm getting from an associative hatch, that's why
    i was asking how to convert the existing unassociative to associative.
     
    Josh Limas, Oct 7, 2004
    #4
  5. Josh Limas

    The Cad Man Guest

    This routine recreates the boundary on a hatch. Maybe it will help?



    (defun c:hb () (c:hatchb)) ; this line can be commented out if there is an
    existing command called hb
    (defun c:hatchb (/ es blay ed1 ed2 loops1 bptf part
    et noe plist ic bul nr ang1 ang2 obj
    *ModelSpace* *PaperSpace*
    space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss
    lwp
    list->variantArray 3dPoint->2dPoint A2k ent i ss2
    knot-list controlpoint-list kn cn pos
    )
    (setq A2k (wcmatch (getvar "ACADVER") "15*"))
    (if A2k
    (defun list->variantArray (ptsList / arraySpace sArray)
    (setq arraySpace
    (vlax-make-safearray
    vlax-vbdouble
    (cons 0 (- (length ptsList) 1))
    )
    )
    (setq sArray (vlax-safearray-fill arraySpace ptsList))
    (vlax-make-variant sArray)
    )
    )
    (if A2k
    (defun 3dPoint->2dPoint (3dpt)
    (list (float (car 3dpt)) (float (cadr 3dpt)))
    )
    )

    (defun errexit (s)
    (princ "\nError: ")
    (princ s)
    (restore)
    )

    (defun undox ()
    (command "._ucs" "_p")
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
    )

    (setq olderr *error*
    restore undox
    *error* errexit
    )
    (setq oldcmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (command "._UNDO" "_BE")
    (if A2k (progn
    (vl-load-com)
    (setq *ModelSpace* (vla-get-ModelSpace
    (vla-get-ActiveDocument (vlax-get-acad-object))
    )
    *PaperSpace* (vla-get-PaperSpace
    (vla-get-ActiveDocument (vlax-get-acad-object))
    )
    ))
    )
    (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
    (progn
    (setq i 0)
    (while (setq ent (ssname ss2 i))
    (setq ed1 (entget ent))
    (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "\nHatch
    not in WCS!"))
    (command "._ucs" "_w")
    (setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)
    (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
    (setq space *ModelSpace*)
    (setq space *PaperSpace*)
    )
    (repeat loops1
    (setq ed1 (member (assoc 92 ed1) ed1))
    (setq bptf (cdr (car ed1))) ; boundary path type flag
    (setq ic (cdr (assoc 73 ed1))) ; is closed
    (setq noe (cdr (assoc 93 ed1))) ; number of edges
    (setq ed1 (member (assoc 72 ed1) ed1))
    (setq bul (cdr (car ed1))) ; bulge
    (setq plist nil)
    (setq blist nil)
    (cond
    ((> (boole 1 bptf 2) 0) ; polyline
    (repeat noe
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (setq plist (append plist (list (cdr (assoc 10 ed1)))))
    (setq blist (append blist
    (if (> bul 0)
    (list (cdr (assoc 42 ed1)))
    nil
    )
    )
    )
    )
    (if A2k (progn
    (setq polypoints
    (apply 'append
    (mapcar '3dPoint->2dPoint plist)
    )
    )
    (setq VLADataPts (list->variantArray polypoints))
    (setq obj (vla-addLightweightPolyline space VLADataPts))
    (setq nr 0)
    (repeat (length blist)
    (if (/= (nth nr blist) 0)
    (vla-setBulge obj nr (nth nr blist))
    )
    (setq nr (1+ nr))
    )
    (if (= ic 1)
    (vla-put-closed obj T)
    )
    )
    (progn
    (if (= ic 1)
    (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
    (entmake '((0 . "POLYLINE") (66 . 1)))
    )
    (setq nr 0)
    (repeat (length plist)
    (if (= bul 0)
    (entmake (list (cons 0 "VERTEX")
    (cons 10 (nth nr plist))
    )
    )
    (entmake (list (cons 0 "VERTEX")
    (cons 10 (nth nr plist))
    (cons 42 (nth nr blist))
    )
    )
    )
    (setq nr (1+ nr))
    )
    (entmake '((0 . "SEQEND")))
    )
    )
    )
    (t ; not polyline
    (setq lastent (entlast))
    (setq lwp T)
    (repeat noe
    (setq et (cdr (assoc 72 ed1)))
    (cond
    ((= et 1) ; line
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (if A2k
    (vla-AddLine
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (vlax-3d-point (cdr (assoc 11 ed1)))
    )
    (entmake
    (list (cons 0 "LINE") (assoc 10 ed1) (assoc 11 ed1))
    )
    )
    (setq ed1 (cddr ed1))
    )
    ((= et 2) ; circular arc
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (setq ang1 (cdr (assoc 50 ed1)))
    (setq ang2 (cdr (assoc 51 ed1)))
    (setq cw (cdr (assoc 73 ed1)))
    (if (equal ang2 6.28319 0.00001)
    (progn
    (if A2k
    (vla-AddCircle
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (cdr (assoc 40 ed1))
    )
    (entmake (list (cons 0 "CIRCLE")
    (assoc 10 ed1)
    (assoc 40 ed1)
    )
    )
    )
    (setq lwp nil)
    )
    (if A2k
    (vla-AddArc
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (cdr (assoc 40 ed1))
    (if (= cw 0)
    (- 0 ang2)
    ang1
    )
    (if (= cw 0)
    (- 0 ang1)
    ang2
    )
    )
    (entmake (list (cons 0 "ARC")
    (assoc 10 ed1)
    (assoc 40 ed1)
    (cons 50
    (if (= cw 0)
    (- 0 ang2)
    ang1
    )
    )
    (cons 51
    (if (= cw 0)
    (- 0 ang1)
    ang2
    )
    )
    )
    )
    )
    )
    (setq ed1 (cddddr ed1))
    )
    ((= et 3) ; elliptic arc
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (setq ang1 (cdr (assoc 50 ed1)))
    (setq ang2 (cdr (assoc 51 ed1)))
    (setq cw (cdr (assoc 73 ed1)))
    (if A2k (progn
    (setq obj (vla-AddEllipse
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (vlax-3d-point (cdr (assoc 11 ed1)))
    (cdr (assoc 40 ed1))
    )
    )
    (vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
    (vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
    )
    (princ "\nElliptic arc not supported!")
    )
    (setq lwp nil)
    )
    ((= et 4) ; spline
    (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
    (setq knot-list nil)
    (setq controlpoint-list nil)
    (setq kn (cdr (assoc 95 ed1)))
    (setq cn (cdr (assoc 96 ed1)))
    (setq pos (vl-position (assoc 40 ed1) ed1))
    (repeat kn
    (setq knot-list (cons (cons 40 (cdr (nth pos ed1)))
    knot-list))
    (setq pos (1+ pos))
    )
    (setq pos (vl-position (assoc 10 ed1) ed1))
    (repeat cn
    (setq controlpoint-list (cons (cons 10 (cdr (nth pos
    ed1))) controlpoint-list))
    (setq pos (1+ pos))
    )
    (setq knot-list (reverse knot-list))
    (setq controlpoint-list (reverse controlpoint-list))
    (entmake (append
    (list '(0 . "SPLINE"))
    (list (cons 100 "AcDbEntity"))
    (list (cons 100 "AcDbSpline"))
    (list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74
    ed1))) (* 4 (cdr (assoc 73 ed1))))))
    (list (cons 71 (cdr (assoc 94 ed1))))
    (list (cons 72 kn))
    (list (cons 73 cn))
    knot-list
    controlpoint-list
    )
    )
    (setq ed1 (member (assoc 10 ed1) ed1))
    (setq lwp nil)
    )
    ) ; end cond
    ) ; end repeat noe
    (if lwp (progn
    (setq en1 (entnext lastent))
    (setq ss (ssadd))
    (ssadd en1 ss)
    (while (setq en2 (entnext en1))
    (ssadd en2 ss)
    (setq en1 en2)
    )
    (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
    ))
    ) ; end t
    ) ; end cond
    ) ; end repeat loops1
    (setq i (1+ i))
    )
    )
    )
    (restore)
    (princ)
    );;
     
    The Cad Man, Oct 7, 2004
    #5
  6. Josh Limas

    Rudy Tovar Guest

    And they thought I was nuts 7 years ago...

    I wrote a utility that recreated a nonassociative hatch to an associative
    hatch in R14...simply because there's one fool in every office that will
    delete the boundary...

    But 2000 is different...I do know that another individual made one to work
    for 2000+

    And it's, I believe posted on the www.digitalcad.com
    website.

    My version can be found on this newsgroup, if you can go back as far as
    maybe 5 years.
     
    Rudy Tovar, Oct 8, 2004
    #6
  7. Josh Limas

    Rudy Tovar Guest

    Here's the one that was posted...

    (defun c:hb () (c:hatchb)) ; this line can be commented out if there is an
    existing command called hb
    (defun c:hatchb (/ es blay ed1 ed2 loops1 bptf part
    et noe plist ic bul nr ang1 ang2 obj *ModelSpace* *PaperSpace*
    space cw errexit undox olderr oldcmdecho ss1 lastent en1 en2 ss lwp
    list->variantArray 3dPoint->2dPoint A2k ent i ss2
    knot-list controlpoint-list kn cn pos xv bot area hst
    )
    (setq A2k (>= (substr (getvar "ACADVER") 1 2) "15"))
    (if A2k
    (progn
    (defun list->variantArray (ptsList / arraySpace sArray)
    (setq arraySpace
    (vlax-make-safearray
    vlax-vbdouble
    (cons 0 (- (length ptsList) 1))
    )
    )
    (setq sArray (vlax-safearray-fill arraySpace ptsList))
    (vlax-make-variant sArray)
    )
    (defun areaOfObject (en / curve area)
    (if en
    (if A2k
    (progn
    (setq curve (vlax-ename->vla-object en))
    (if
    (vl-catch-all-error-p
    (setq
    area
    (vl-catch-all-apply 'vlax-curve-getArea (list curve))
    )
    )
    nil
    area
    )
    )
    (progn
    (command "._area" "_O" en)
    (getvar "area")
    )
    )
    )
    )
    )
    )
    (if A2k
    (defun 3dPoint->2dPoint (3dpt)
    (list (float (car 3dpt)) (float (cadr 3dpt)))
    )
    )

    (defun errexit (s)
    (princ "Error: ")
    (princ s)
    (restore)
    )

    (defun undox ()
    (command "._ucs" "_p")
    (command "._undo" "_E")
    (setvar "cmdecho" oldcmdecho)
    (setq *error* olderr)
    (princ)
    )

    (setq olderr *error*
    restore undox
    *error* errexit
    )
    (setq oldcmdecho (getvar "cmdecho"))
    (setvar "cmdecho" 0)
    (command "._UNDO" "_BE")
    (if A2k (progn
    (vl-load-com)
    (setq *ModelSpace* (vla-get-ModelSpace
    (vla-get-ActiveDocument (vlax-get-acad-object))
    )
    *PaperSpace* (vla-get-PaperSpace
    (vla-get-ActiveDocument (vlax-get-acad-object))
    )
    ))
    )


    ; For testing purpose
    ; (setq A2k nil)

    (if (/= (setq ss2 (ssget '((0 . "HATCH")))) nil)
    (progn
    (setq i 0)
    (setq area 0)
    (setq bMoreLoops nil)
    (while (setq ent (ssname ss2 i))
    (setq ed1 (entget ent))
    (if (not (equal (assoc 210 ed1) '(210 0.0 0.0 1.0))) (princ "Hatch not in
    WCS!"))
    (setq xv (cdr (assoc 210 ed1)))
    (command "._ucs" "_w")
    (setq loops1 (cdr (assoc 91 ed1))) ; number of boundary paths (loops)
    (if (and A2k (= (strcase (cdr (assoc 410 ed1))) "MODEL"))
    (setq space *ModelSpace*)
    (setq space *PaperSpace*)
    )
    (repeat loops1
    (setq ed1 (member (assoc 92 ed1) ed1))
    (setq bptf (cdr (car ed1))) ; boundary path type flag
    (setq ic (cdr (assoc 73 ed1))) ; is closed
    (setq noe (cdr (assoc 93 ed1))) ; number of edges
    (setq bot (cdr (assoc 92 ed1))) ; boundary type
    (setq hst (cdr (assoc 75 ed1))) ; hatch style
    (setq ed1 (member (assoc 72 ed1) ed1))
    (setq bul (cdr (car ed1))) ; bulge
    (setq plist nil)
    (setq blist nil)
    (cond
    ((> (boole 1 bptf 2) 0) ; polyline
    (repeat noe
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (setq plist (append plist (list (cdr (assoc 10 ed1)))))
    (setq blist (append blist
    (if (> bul 0)
    (list (cdr (assoc 42 ed1)))
    nil
    )
    )
    )
    )
    (if A2k (progn
    (setq polypoints
    (apply 'append
    (mapcar '3dPoint->2dPoint plist)
    )
    )
    (setq VLADataPts (list->variantArray polypoints))
    (setq obj (vla-addLightweightPolyline space VLADataPts))
    (setq nr 0)
    (repeat (length blist)
    (if (/= (nth nr blist) 0)
    (vla-setBulge obj nr (nth nr blist))
    )
    (setq nr (1+ nr))
    )
    (if (= ic 1)
    (vla-put-closed obj T)
    )
    )
    (progn
    (if (= ic 1)
    (entmake '((0 . "POLYLINE") (66 . 1) (70 . 1)))
    (entmake '((0 . "POLYLINE") (66 . 1)))
    )
    (setq nr 0)
    (repeat (length plist)
    (if (= bul 0)
    (entmake (list (cons 0 "VERTEX")
    (cons 10 (nth nr plist))
    )
    )
    (entmake (list (cons 0 "VERTEX")
    (cons 10 (nth nr plist))
    (cons 42 (nth nr blist))
    )
    )
    )
    (setq nr (1+ nr))
    )
    (entmake '((0 . "SEQEND")))
    )
    )
    )
    (t ; not polyline
    (setq lastent (entlast))
    (setq lwp T)
    (repeat noe
    (setq et (cdr (assoc 72 ed1)))
    (cond
    ((= et 1) ; line
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (if A2k
    (vla-AddLine
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (vlax-3d-point (cdr (assoc 11 ed1)))
    )
    (entmake
    (list
    (cons 0 "LINE")
    (list 10 (cadr (assoc 10 ed1)) (caddr (assoc 10 ed1)) 0)
    (list 11 (cadr (assoc 11 ed1)) (caddr (assoc 11 ed1)) 0)
    ; (cons 210 xv)
    )
    )
    )
    (setq ed1 (cddr ed1))
    )
    ((= et 2) ; circular arc
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (setq ang1 (cdr (assoc 50 ed1)))
    (setq ang2 (cdr (assoc 51 ed1)))
    (setq cw (cdr (assoc 73 ed1)))
    (if (equal ang2 6.28319 0.00001)
    (progn
    (if A2k
    (vla-AddCircle
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (cdr (assoc 40 ed1))
    )
    (entmake (list (cons 0 "CIRCLE")
    (assoc 10 ed1)
    (assoc 40 ed1)
    )
    )
    )
    (setq lwp nil)
    )
    (if A2k
    (vla-AddArc
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (cdr (assoc 40 ed1))
    (if (= cw 0)
    (- 0 ang2)
    ang1
    )
    (if (= cw 0)
    (- 0 ang1)
    ang2
    )
    )
    (entmake (list (cons 0 "ARC")
    (assoc 10 ed1)
    (assoc 40 ed1)
    (cons 50
    (if (= cw 0)
    (- 0 ang2)
    ang1
    )
    )
    (cons 51
    (if (= cw 0)
    (- 0 ang1)
    ang2
    )
    )
    )
    )
    )
    )
    (setq ed1 (cddddr ed1))
    )
    ((= et 3) ; elliptic arc
    (setq ed1 (member (assoc 10 (cdr ed1)) ed1))
    (setq ang1 (cdr (assoc 50 ed1)))
    (setq ang2 (cdr (assoc 51 ed1)))
    (setq cw (cdr (assoc 73 ed1)))
    (if A2k (progn
    (setq obj (vla-AddEllipse
    space
    (vlax-3d-point (cdr (assoc 10 ed1)))
    (vlax-3d-point (cdr (assoc 11 ed1)))
    (cdr (assoc 40 ed1))
    )
    )
    (vla-put-startangle obj (if (= cw 0) (- 0 ang2) ang1))
    (vla-put-endangle obj (if (= cw 0) (- 0 ang1) ang2))
    )
    (princ "Elliptic arc not supported!")
    )
    (setq lwp nil)
    )
    ((= et 4) ; spline
    (setq ed1 (member (assoc 94 (cdr ed1)) ed1))
    (setq knot-list nil)
    (setq controlpoint-list nil)
    (setq kn (cdr (assoc 95 ed1)))
    (setq cn (cdr (assoc 96 ed1)))
    (setq pos (vl-position (assoc 40 ed1) ed1))
    (repeat kn
    (setq knot-list (cons (cons 40 (cdr (nth pos ed1))) knot-list))
    (setq pos (1+ pos))
    )
    (setq pos (vl-position (assoc 10 ed1) ed1))
    (repeat cn
    (setq controlpoint-list (cons (cons 10 (cdr (nth pos ed1)))
    controlpoint-list))
    (setq pos (1+ pos))
    )
    (setq knot-list (reverse knot-list))
    (setq controlpoint-list (reverse controlpoint-list))
    (entmake (append
    (list '(0 . "SPLINE"))
    (list (cons 100 "AcDbEntity"))
    (list (cons 100 "AcDbSpline"))
    (list (cons 70 (+ 1 8 (* 2 (cdr (assoc 74 ed1))) (* 4 (cdr (assoc 73
    ed1))))))
    (list (cons 71 (cdr (assoc 94 ed1))))
    (list (cons 72 kn))
    (list (cons 73 cn))
    knot-list
    controlpoint-list
    )
    )
    (setq ed1 (member (assoc 10 ed1) ed1))
    (setq lwp nil)
    )
    ) ; end cond
    ) ; end repeat noe
    (if lwp (progn
    (setq en1 (entnext lastent))
    (setq ss (ssadd))
    (ssadd en1 ss)
    (while (setq en2 (entnext en1))
    (ssadd en2 ss)
    (setq en1 en2)
    )
    (if (= (getvar "peditaccept") 1)
    (command "_.pedit" (entlast) "_J" ss "" "")
    (command "_.pedit" (entlast) "_Y" "_J" ss "" "")
    )
    ))

    ) ; end t
    ) ; end cond
    ; Tries to get the area on islands but it's not clear how to know if an
    island is filled or not
    ; and if it should be substracted or added to the total area.
    ; (if (or (= bot 0) (= (boole 1 bot 1) 1)) (setq area (+ area (areaOfObject
    (entlast)))))
    ; (if (and (/= hst 1) (/= bot 0) (= (boole 1 bot 1) 0)) (setq area (- area
    (areaOfObject (entlast)))))
    ; (princ "") (princ bot) (princ "") (princ hst) (princ "")
    ; (princ (areaOfObject (entlast)))
    ) ; end repeat loops1
    (if (= loops1 1) (setq area (+ area (areaOfObject (entlast)))) (setq
    bMoreLoops T))
    (setq i (1+ i))
    )
    )
    )
    (if (and area (not bMoreLoops)) (progn
    (princ "Total Area = ")
    (princ area)
    ))
    (restore)
    (princ)
    )
     
    Rudy Tovar, Oct 8, 2004
    #7
  8. Josh Limas

    Rudy Tovar Guest

    Rats, same one posted...,but it doesn't work for 2002...

    Here's the one I posted, but will have to be modified for 2000+...

    (defun c:ha (/ ent ent-inf ent-typ pass cl hatch hatch-ent hatch-nam
    hatch-rot hatch-sca hatch-lay hatch-len cnt)
    (setq hatch-points nil
    hatch-info nil
    point nil
    len nil
    cnt nil
    point-list1 nil
    point-list2 nil
    )

    (setq ent (entsel))

    (if ent
    (progn
    (setq ent-inf (entget (car ent)))
    (setq ent-typ (cdr (assoc 0 ent-inf)))
    )
    )

    (setq cl (getvar "clayer"))
    (setvar "clayer" cl)

    (if (and ent (= ent-typ "HATCH"))
    (progn

    (setq hatch-info (entget (car ent))
    hatch-ent (cdr (assoc -1 hatch-info))
    hatch-nam (cdr (assoc 2 hatch-info))
    hatch-rot (cdr (assoc 52 hatch-info))
    hatch-sca (cdr (assoc 41 hatch-info))
    hatch-len (- (length hatch-info) 1)
    hatch-lay (cdr (assoc 8 hatch-info))
    )

    (setq hcnt 0)

    (if hatch-len
    (setvar "clayer" hatch-lay)
    )

    (if (and (assoc 93 hatch-info)(not (assoc 330 hatch-info)))
    (setq hatch-len nil
    pass 2
    )
    )


    (if (= pass 2)
    (hatch-multi-boundaries)
    )



    (if (and (not (= pass 2))(not (assoc 330 hatch-info)))
    (progn
    (entdel hatch-ent)
    (setvar "hpname" hatch-nam)
    (setvar "hpscale" hatch-sca)
    (if (not (= (getvar"hpang") hatch-rot))(setvar "hpang" hatch-rot))
    (setq hatch-points (append hatch-points (list "c")))
    (command "pline" (mapcar 'command hatch-points))
    (1hatch-add-boundary)

    (command "bhatch" "a" "a" "y" "" "s" (mapcar 'command ent-list))
    )
    )

    (if (and(= pass 2)(not (assoc 330 hatch-info)))
    (progn
    (entdel hatch-ent)
    (setvar "hpname" hatch-nam)
    (setvar "hpscale" hatch-sca)
    (if (not (= (getvar"hpang") hatch-rot))(setvar "hpang" hatch-rot))
    (setq ent-list nil)
    (setq len (length point-list2))
    (setq cnt 0)
    (repeat len
    (if (= (nth (1- len) point-list2) "c")
    (command "pline"
    (mapcar 'command point-list2)
    )
    )
    (if (not (= (nth (1- len) point-list2) "c"))
    (command "pline"
    (mapcar 'command (nth cnt point-list2))
    )
    )

    (setq ent-list (append ent-list (list (entlast))))
    (setq cnt (1+ cnt))
    )
    (setq len (length ent-list))
    (setq cnt 0)
    (setq ent-list (append ent-list (list "")))
    (setq ent-list (append ent-list (list "")))
    (1hatch-add-boundary)
    (command "bhatch" "a" "a" "y" "" "s" (mapcar 'command ent-list))

    )
    )

    )

    )

    (if (assoc 330 hatch-info)(Alert "Hatch is already an Associative"))
    (setq hatch-info nil
    point nil
    len nil
    cnt2 nil
    )
    (setvar "clayer" cl)
    (if (and ent-typ (not(= ent-typ "HATCH"))) (alert "Entity is NOT A
    HATCH"))


    (princ)
    )




    (defun hatch-multi-boundaries (/ cnt hatch-len cnt2 point point-list1)

    (setq point-list1 nil)
    (setq point-list2 nil)

    (setq cnt 0)
    (setq hatch-len (length hatch-info))

    (repeat hatch-len

    (if (= (car (nth cnt hatch-info)) 93)
    (progn
    (setq cnt2 (cdr (nth cnt hatch-info)))
    (setq cnt (1+ cnt))

    (while cnt2
    (if (and cnt2 (= (car (nth cnt hatch-info)) 10))
    (setq point (cdr (nth cnt hatch-info))
    point (list (append point (list 0.0)))
    point-list1 (append point-list1 point)
    )
    ); end of if

    (if cnt2 (setq cnt (1+ cnt)))
    (if (= (car (nth cnt hatch-info)) 97)(setq cnt2 nil))
    )
    )
    )

    (if (or (= (car (nth (1+ cnt) hatch-info)) 93)(= (car (nth (1+ cnt)
    hatch-info)) 52))
    (progn
    (if point-list1
    (progn
    (setq point-list1 (append point-list1 (list "c")))
    (setq point-list2 (append point-list2 (list point-list1)))
    (setq point-list1 nil)
    )
    )
    )
    )

    (setq cnt (1+ cnt))
    )
    (if (= point-list2 nil)
    (progn
    (setq point-list1 (append point-list1 (list "c")))
    (setq point-list2 point-list1)
    )
    )
    (princ)
    )




    (defun 1hatch-add-boundary (/ new-boundary)

    (prompt "\Select NEW Boundaries to ADD?...")
    (setq new-boundary (ssget))



    (if new-boundary
    (setq ent-list (append (list new-boundary) ent-list))
    )



    (princ)
    )

    --
    MASi
    Copyright 2004 by Cadentity
    www.Cadentity.com
     
    Rudy Tovar, Oct 8, 2004
    #8
  9. Josh Limas

    David Allen Guest

    Rudy

    You got to look around in our company menu
    Its under Draw > Hatch Boundary

    "Rudy Tovar" <>
    |>Rats, same one posted...,but it doesn't work for 2002...
    |>
    |>Here's the one I posted, but will have to be modified for 2000+...
    |>
    |>(defun c:ha (/ ent ent-inf ent-typ pass cl hatch hatch-ent hatch-nam
    |>hatch-rot hatch-sca hatch-lay hatch-len cnt)
    |> (setq hatch-points nil
    |> hatch-info nil
    |> point nil
    |> len nil
    |> cnt nil
    |> point-list1 nil
    |> point-list2 nil
    |> )
    |>
    |> (setq ent (entsel))
    |>
    |> (if ent
    |> (progn
    |> (setq ent-inf (entget (car ent)))
    |> (setq ent-typ (cdr (assoc 0 ent-inf)))
    |> )
    |> )
    |>
    |> (setq cl (getvar "clayer"))
    |> (setvar "clayer" cl)
    |>
    |> (if (and ent (= ent-typ "HATCH"))
    |> (progn
    |>
    |> (setq hatch-info (entget (car ent))
    |> hatch-ent (cdr (assoc -1 hatch-info))
    |> hatch-nam (cdr (assoc 2 hatch-info))
    |> hatch-rot (cdr (assoc 52 hatch-info))
    |> hatch-sca (cdr (assoc 41 hatch-info))
    |> hatch-len (- (length hatch-info) 1)
    |> hatch-lay (cdr (assoc 8 hatch-info))
    |> )
    |>
    |> (setq hcnt 0)
    |>
    |> (if hatch-len
    |> (setvar "clayer" hatch-lay)
    |> )
    |>
    |> (if (and (assoc 93 hatch-info)(not (assoc 330 hatch-info)))
    |> (setq hatch-len nil
    |> pass 2
    |> )
    |> )
    |>
    |>
    |> (if (= pass 2)
    |> (hatch-multi-boundaries)
    |> )
    |>
    |>
    |>
    |> (if (and (not (= pass 2))(not (assoc 330 hatch-info)))
    |> (progn
    |> (entdel hatch-ent)
    |> (setvar "hpname" hatch-nam)
    |> (setvar "hpscale" hatch-sca)
    |> (if (not (= (getvar"hpang") hatch-rot))(setvar "hpang" hatch-rot))
    |> (setq hatch-points (append hatch-points (list "c")))
    |> (command "pline" (mapcar 'command hatch-points))
    |> (1hatch-add-boundary)
    |>
    |> (command "bhatch" "a" "a" "y" "" "s" (mapcar 'command ent-list))
    |> )
    |> )
    |>
    |> (if (and(= pass 2)(not (assoc 330 hatch-info)))
    |> (progn
    |> (entdel hatch-ent)
    |> (setvar "hpname" hatch-nam)
    |> (setvar "hpscale" hatch-sca)
    |> (if (not (= (getvar"hpang") hatch-rot))(setvar "hpang" hatch-rot))
    |> (setq ent-list nil)
    |> (setq len (length point-list2))
    |> (setq cnt 0)
    |> (repeat len
    |> (if (= (nth (1- len) point-list2) "c")
    |> (command "pline"
    |> (mapcar 'command point-list2)
    |> )
    |> )
    |> (if (not (= (nth (1- len) point-list2) "c"))
    |> (command "pline"
    |> (mapcar 'command (nth cnt point-list2))
    |> )
    |> )
    |>
    |> (setq ent-list (append ent-list (list (entlast))))
    |> (setq cnt (1+ cnt))
    |> )
    |> (setq len (length ent-list))
    |> (setq cnt 0)
    |> (setq ent-list (append ent-list (list "")))
    |> (setq ent-list (append ent-list (list "")))
    |> (1hatch-add-boundary)
    |> (command "bhatch" "a" "a" "y" "" "s" (mapcar 'command ent-list))
    |>
    |> )
    |> )
    |>
    |> )
    |>
    |> )
    |>
    |> (if (assoc 330 hatch-info)(Alert "Hatch is already an Associative"))
    |> (setq hatch-info nil
    |> point nil
    |> len nil
    |> cnt2 nil
    |> )
    |> (setvar "clayer" cl)
    |> (if (and ent-typ (not(= ent-typ "HATCH"))) (alert "Entity is NOT A
    |>HATCH"))
    |>
    |>
    |> (princ)
    |>)
    |>
    |>
    |>
    |>
    |>(defun hatch-multi-boundaries (/ cnt hatch-len cnt2 point point-list1)
    |>
    |> (setq point-list1 nil)
    |> (setq point-list2 nil)
    |>
    |> (setq cnt 0)
    |> (setq hatch-len (length hatch-info))
    |>
    |> (repeat hatch-len
    |>
    |> (if (= (car (nth cnt hatch-info)) 93)
    |> (progn
    |> (setq cnt2 (cdr (nth cnt hatch-info)))
    |> (setq cnt (1+ cnt))
    |>
    |> (while cnt2
    |> (if (and cnt2 (= (car (nth cnt hatch-info)) 10))
    |> (setq point (cdr (nth cnt hatch-info))
    |> point (list (append point (list 0.0)))
    |> point-list1 (append point-list1 point)
    |> )
    |> ); end of if
    |>
    |> (if cnt2 (setq cnt (1+ cnt)))
    |> (if (= (car (nth cnt hatch-info)) 97)(setq cnt2 nil))
    |> )
    |> )
    |> )
    |>
    |> (if (or (= (car (nth (1+ cnt) hatch-info)) 93)(= (car (nth (1+ cnt)
    |>hatch-info)) 52))
    |> (progn
    |> (if point-list1
    |> (progn
    |> (setq point-list1 (append point-list1 (list "c")))
    |> (setq point-list2 (append point-list2 (list point-list1)))
    |> (setq point-list1 nil)
    |> )
    |> )
    |> )
    |> )
    |>
    |> (setq cnt (1+ cnt))
    |> )
    |> (if (= point-list2 nil)
    |> (progn
    |> (setq point-list1 (append point-list1 (list "c")))
    |> (setq point-list2 point-list1)
    |> )
    |> )
    |> (princ)
    |>)
    |>
    |>
    |>
    |>
    |>(defun 1hatch-add-boundary (/ new-boundary)
    |>
    |> (prompt "\Select NEW Boundaries to ADD?...")
    |> (setq new-boundary (ssget))
    |>
    |>
    |>
    |> (if new-boundary
    |> (setq ent-list (append (list new-boundary) ent-list))
    |> )
    |>
    |>
    |>
    |> (princ)
    |>)


    David
     
    David Allen, Oct 8, 2004
    #9
  10. Josh Limas

    Rudy Tovar Guest

    Talk about reinventing the wheel...

    You should have asked me for it seven years ago.
     
    Rudy Tovar, Oct 8, 2004
    #10
  11. Josh Limas

    Rudy Tovar Guest

    You have to read the fine print David...

    Make a non-associative hatch Associative.

    And that function doesn't recreate all the boundaries, Mine did, with arcs
    and budges...and made it assoicative again...meaning that it could be
    stretched. Ask Rob Star he was the first to comment on it way back, and save
    him time on a project he was working on.

    The one I posted is the first version that simply created multiple polygons
    boundaries defined, and not just the first as does the one you mentioned.

    My second version recreated the boundaries with arcs splines etc. and
    associative again.
     
    Rudy Tovar, Oct 8, 2004
    #11
  12. Josh Limas

    David Allen Guest

    that's great, then put it into the menu and lets use that one.

    FYI I didn't know you 7 years ago :p


    "Rudy Tovar" <>
    |>You have to read the fine print David...
    |>
    |>Make a non-associative hatch Associative.
    |>
    |>And that function doesn't recreate all the boundaries, Mine did, with arcs
    |>and budges...and made it assoicative again...meaning that it could be
    |>stretched. Ask Rob Star he was the first to comment on it way back, and save
    |>him time on a project he was working on.
    |>
    |>The one I posted is the first version that simply created multiple polygons
    |>boundaries defined, and not just the first as does the one you mentioned.
    |>
    |>My second version recreated the boundaries with arcs splines etc. and
    |>associative again.
    |>
    |>|>> Rudy
    |>>
    |>> You got to look around in our company menu
    |>> Its under Draw > Hatch Boundary
    |>>
    |>> "Rudy Tovar" <>
    |>> |>Rats, same one posted...,but it doesn't work for 2002...
    |>> |>
    |>> |>Here's the one I posted, but will have to be modified for 2000+...
    |>> |>
    |>> |>(defun c:ha (/ ent ent-inf ent-typ pass cl hatch hatch-ent hatch-nam
    |>> |>hatch-rot hatch-sca hatch-lay hatch-len cnt)
    |>> |> (setq hatch-points nil
    |>> |> hatch-info nil
    |>> |> point nil
    |>> |> len nil
    |>> |> cnt nil
    |>> |> point-list1 nil
    |>> |> point-list2 nil
    |>> |> )
    |>> |>
    |>> |> (setq ent (entsel))
    |>> |>
    |>> |> (if ent
    |>> |> (progn
    |>> |> (setq ent-inf (entget (car ent)))
    |>> |> (setq ent-typ (cdr (assoc 0 ent-inf)))
    |>> |> )
    |>> |> )
    |>> |>
    |>> |> (setq cl (getvar "clayer"))
    |>> |> (setvar "clayer" cl)
    |>> |>
    |>> |> (if (and ent (= ent-typ "HATCH"))
    |>> |> (progn
    |>> |>
    |>> |> (setq hatch-info (entget (car ent))
    |>> |> hatch-ent (cdr (assoc -1 hatch-info))
    |>> |> hatch-nam (cdr (assoc 2 hatch-info))
    |>> |> hatch-rot (cdr (assoc 52 hatch-info))
    |>> |> hatch-sca (cdr (assoc 41 hatch-info))
    |>> |> hatch-len (- (length hatch-info) 1)
    |>> |> hatch-lay (cdr (assoc 8 hatch-info))
    |>> |> )
    |>> |>
    |>> |> (setq hcnt 0)
    |>> |>
    |>> |> (if hatch-len
    |>> |> (setvar "clayer" hatch-lay)
    |>> |> )
    |>> |>
    |>> |> (if (and (assoc 93 hatch-info)(not (assoc 330 hatch-info)))
    |>> |> (setq hatch-len nil
    |>> |> pass 2
    |>> |> )
    |>> |> )
    |>> |>
    |>> |>
    |>> |> (if (= pass 2)
    |>> |> (hatch-multi-boundaries)
    |>> |> )
    |>> |>
    |>> |>
    |>> |>
    |>> |> (if (and (not (= pass 2))(not (assoc 330 hatch-info)))
    |>> |> (progn
    |>> |> (entdel hatch-ent)
    |>> |> (setvar "hpname" hatch-nam)
    |>> |> (setvar "hpscale" hatch-sca)
    |>> |> (if (not (= (getvar"hpang") hatch-rot))(setvar "hpang"
    |>> hatch-rot))
    |>> |> (setq hatch-points (append hatch-points (list "c")))
    |>> |> (command "pline" (mapcar 'command hatch-points))
    |>> |> (1hatch-add-boundary)
    |>> |>
    |>> |> (command "bhatch" "a" "a" "y" "" "s" (mapcar 'command ent-list))
    |>> |> )
    |>> |> )
    |>> |>
    |>> |> (if (and(= pass 2)(not (assoc 330 hatch-info)))
    |>> |> (progn
    |>> |> (entdel hatch-ent)
    |>> |> (setvar "hpname" hatch-nam)
    |>> |> (setvar "hpscale" hatch-sca)
    |>> |> (if (not (= (getvar"hpang") hatch-rot))(setvar "hpang"
    |>> hatch-rot))
    |>> |> (setq ent-list nil)
    |>> |> (setq len (length point-list2))
    |>> |> (setq cnt 0)
    |>> |> (repeat len
    |>> |> (if (= (nth (1- len) point-list2) "c")
    |>> |> (command "pline"
    |>> |> (mapcar 'command point-list2)
    |>> |> )
    |>> |> )
    |>> |> (if (not (= (nth (1- len) point-list2) "c"))
    |>> |> (command "pline"
    |>> |> (mapcar 'command (nth cnt point-list2))
    |>> |> )
    |>> |> )
    |>> |>
    |>> |> (setq ent-list (append ent-list (list (entlast))))
    |>> |> (setq cnt (1+ cnt))
    |>> |> )
    |>> |> (setq len (length ent-list))
    |>> |> (setq cnt 0)
    |>> |> (setq ent-list (append ent-list (list "")))
    |>> |> (setq ent-list (append ent-list (list "")))
    |>> |> (1hatch-add-boundary)
    |>> |> (command "bhatch" "a" "a" "y" "" "s" (mapcar 'command ent-list))
    |>> |>
    |>> |> )
    |>> |> )
    |>> |>
    |>> |> )
    |>> |>
    |>> |> )
    |>> |>
    |>> |> (if (assoc 330 hatch-info)(Alert "Hatch is already an
    |>> Associative"))
    |>> |> (setq hatch-info nil
    |>> |> point nil
    |>> |> len nil
    |>> |> cnt2 nil
    |>> |> )
    |>> |> (setvar "clayer" cl)
    |>> |> (if (and ent-typ (not(= ent-typ "HATCH"))) (alert "Entity is NOT A
    |>> |>HATCH"))
    |>> |>
    |>> |>
    |>> |> (princ)
    |>> |>)
    |>> |>
    |>> |>
    |>> |>
    |>> |>
    |>> |>(defun hatch-multi-boundaries (/ cnt hatch-len cnt2 point point-list1)
    |>> |>
    |>> |> (setq point-list1 nil)
    |>> |> (setq point-list2 nil)
    |>> |>
    |>> |> (setq cnt 0)
    |>> |> (setq hatch-len (length hatch-info))
    |>> |>
    |>> |> (repeat hatch-len
    |>> |>
    |>> |> (if (= (car (nth cnt hatch-info)) 93)
    |>> |> (progn
    |>> |> (setq cnt2 (cdr (nth cnt hatch-info)))
    |>> |> (setq cnt (1+ cnt))
    |>> |>
    |>> |> (while cnt2
    |>> |> (if (and cnt2 (= (car (nth cnt hatch-info)) 10))
    |>> |> (setq point (cdr (nth cnt hatch-info))
    |>> |> point (list (append point (list 0.0)))
    |>> |> point-list1 (append point-list1 point)
    |>> |> )
    |>> |> ); end of if
    |>> |>
    |>> |> (if cnt2 (setq cnt (1+ cnt)))
    |>> |> (if (= (car (nth cnt hatch-info)) 97)(setq cnt2 nil))
    |>> |> )
    |>> |> )
    |>> |> )
    |>> |>
    |>> |> (if (or (= (car (nth (1+ cnt) hatch-info)) 93)(= (car (nth (1+ cnt)
    |>> |>hatch-info)) 52))
    |>> |> (progn
    |>> |> (if point-list1
    |>> |> (progn
    |>> |> (setq point-list1 (append point-list1 (list "c")))
    |>> |> (setq point-list2 (append point-list2 (list point-list1)))
    |>> |> (setq point-list1 nil)
    |>> |> )
    |>> |> )
    |>> |> )
    |>> |> )
    |>> |>
    |>> |> (setq cnt (1+ cnt))
    |>> |> )
    |>> |> (if (= point-list2 nil)
    |>> |> (progn
    |>> |> (setq point-list1 (append point-list1 (list "c")))
    |>> |> (setq point-list2 point-list1)
    |>> |> )
    |>> |> )
    |>> |> (princ)
    |>> |>)
    |>> |>
    |>> |>
    |>> |>
    |>> |>
    |>> |>(defun 1hatch-add-boundary (/ new-boundary)
    |>> |>
    |>> |> (prompt "\Select NEW Boundaries to ADD?...")
    |>> |> (setq new-boundary (ssget))
    |>> |>
    |>> |>
    |>> |>
    |>> |> (if new-boundary
    |>> |> (setq ent-list (append (list new-boundary) ent-list))
    |>> |> )
    |>> |>
    |>> |>
    |>> |>
    |>> |> (princ)
    |>> |>)
    |>>
    |>>
    |>> David
    |>


    David
     
    David Allen, Oct 11, 2004
    #12
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.