Topic: H.O.S.E. problem

[T.Willey]

I can't seem to figure this out, and it is driving me crazy.  The code works if when prompted to select object you enter ' last ', but if you pick the hatch object it won't work.  To test just draw a hatchable object, then hatch it, then issue the command.  Escape out of it, so that you can test it again, as when you escape the original hatch pattern will be put back.  Any help/insight/confirmation that I'm not crazy appreciated.  When testing, try to drawing the object close to ' (0. 0. 0.) ' as that will be the base point when entering ' last ' when prompted.

Related to: [ http://www.theswamp.org/index.php?topic=26444.0 ]

Sidenote:  If you cancel this program with the command window open with focus, then it will crash Acad hard, without the ability to save the information of any drawing opened.

Code: [Select]

(defun c:HOSE ( / *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 "\n Select hatch to edit 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)
)


[Andrea]

wow..nice work.

it work just fine here..

[Kerry]

Tim,
Works for me without issue , as posted
.. in AC2008


don't have time to play, sorry ;
 .. the dxf 41 ( PatternScale ) may be better using a percentage of the distance [ for metric systems anyway ]

[ronjonp]

Works fine here. Nice job
I was throwing something together as well for fun. I'll post it tomorrow.

[T.Willey]

Thanks guys for testing, and letting me know I'm crazy.    I will try it again here when I get a minute.

Kerry,

  I was trying that for everything, but couldn't get a formula that worked like I wanted it to, and then got sidetracked.  I should have time to look into that today.

Edit:  Just had a thought.  Kerry, do you think it would work better if the code grabbed the correct .pat file?  I could get the measurement system variable, and then based on that either grab the acadiso.pat or the acad.pat file.  /idea

[ronjonp]

...
Edit:  Just had a thought.  Kerry, do you think it would work better if the code grabbed the correct .pat file?  I could get the measurement system variable, and then based on that either grab the acadiso.pat or the acad.pat file.  /idea

Funny you say that....here is part of my routine:

Code: [Select]

(defun hatchpatterns (file / l1 openf out pos)
  (if (and (findfile file) (setq openf (open file "r")))
    (progn (while (setq l1 (read-line openf))
             (if (and (eq (substr l1 1 1) "*")
                      (setq pos (vl-string-search "," l1))
                 )
               (setq out (cons (strcase (substr l1 2 (1- pos))) out))
             )
           )
           (close openf)
           (if (zerop (getvar 'measurement))
             (reverse
               (vl-remove-if '(lambda (x) (wcmatch x "ACAD_ISO*")) out)
             )
             (reverse
               (vl-remove-if-not '(lambda (x) (wcmatch x "ACAD_ISO*")) out)
             )
           )
    )
  )
)*edit....after reading your post better, the solution is to grab the right pat file not remove the iso* patterns correct?
Still working out some kinks then I'll post

[T.Willey]

...
*edit....after reading your post better, the solution is to grab the right pat file not remove the iso* patterns correct?
Still working out some kinks then I'll post

Yup, that is what I was talking about, but I haven't even been up for an hour yet, so I'm just thinking.  Look forward to seeing how you do it Ron.

[CAB]

I'm out of the office so I had time to only test in ACAD2K.
The hatch disappears & doesn't return.
I'll check back later when I get back.

[T.Willey]

I'm out of the office so I had time to only test in ACAD2K.
The hatch disappears & doesn't return.
I'll check back later when I get back.

Thanks Alan, as that is what is still happening here with '06.

[CAB]

Here is a quick fix. The problem is that the grread returns a zero distance until the user moves the mouse.

Code: [Select]

(defun c:HOSE ( / *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 "\n Select hatch to edit 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)
                 (if (not (zerop (distance tempPt BasePt))) ; CAB
                    (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 (and (not (zerop (distance tempPt BasePt))) ; CAB
                             (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)
)

[CAB]

Another problem is when the scale factor is too small. ACAD looks like it freezes but it does come back. So a timer function in the loop to detect and prevent too small a scale would be helpful.

[T.Willey]

OMG Alan!!! how did you ever figure that one out?  I tested it on '08 ( before you told me how to fix it ), and it worked, so I was stumped why it wouldn't work in '06.  Thank You!!

Now to see if I can find the right expression for the scaling of it.  I want it to kind of work different on the different view scale.  When you are zoomed up onto the hatch, it will scale it less, and when you are zoomed out, it will scale it more.  Off to do some stuff.  I have fixed my code to reflect Alan's amazing discovery.  Will post later when I have what I like worked out.

[T.Willey]

Here is the new version that works the way I think it should.  It uses the current scale as the make for 1 unit of distance.  If the current drawing is setup to be metric, then it will grab the acadiso.pat file.  It will let you cycle all the way around, style wise, without an error.

Enjoy.  Comments/ideas/criticisms all welcomed.

One thing you may notice is that when you are scrolling through all the different styles, that the prompt will get looking wrong, that is because of the ' \r ' switch to the ' prompt ' function.  I know one way to clean it, make a prompt string that would be longer than any there and then switch between that and the real one, but I am hoping that there is a better/cleaner way.

Code: [Select]

(defun c:HOSE ( / *error* GetHatchNames Sel Ent EntData oData nStyle cScale BasePt HatchList Pos
    TogAngle tempList tempPt tempData MaxPos )
   
    (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 "\n Select hatch to edit dynamicly: "))
            (setq oData (entget (car Sel)))
            (= (cdr (assoc 0 oData)) "HATCH")
            (setq nStyle (cdr (assoc 2 oData)))
            (setq cScale (cdr (assoc 41 oData)))
            (setq BasePt (cadr Sel))
            (setq HatchList
                (GetHatchNames
                    (if (zerop (getvar 'Measurement))
                        (findfile "acad.pat")
                        (findfile "acadiso.pat")
                    )
                )
            )
            (setq MaxPos (1- (length HatchList)))
            (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))
                    (if (not (zerop (distance tempPt BasePt))) ; <- Thanks to Alan ( CAB )
                        (progn
                            (redraw)
                            (grdraw BasePt tempPt 7)
                            (setq tempData
                                (subst
                                    (cons
                                        41
                                        ;(distance tempPt BasePt)
                                        (* (distance tempPt BasePt) cScale)
                                    )
                                    (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))
                            (if (equal Pos MaxPos)
                                (setq Pos 0)
                            )
                            (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)
)


[ronjonp]

Seems to work here...nice code as usual

[Kerry]

nice looking logic map Tim ...

evolution is great !

[Spike Wilbury]

I see that all like it....

Maybe it is me, .... but does not work for me.

It does the first time, but after playing with the routine for a little, and then I select on the fly the angle toggle, does that, and then I try the Style, it does nothing and I get out of the loop, and try to do the dynamic edition and nada, niep, nil....

Very sorry. 

[Andrea]

nice...

for comment..
you can not rotate the hatch without scaling..
and can not scale without rotating..

this is a little handy when time is come to have the good scale in good rotation.

I suggest to have something like..
[Hatch / Scale / Angle toggle]

so you can switch as demand..

Also,..i have added some options in H.O.S. rel. 2 the ORTHOMODE was very useful here.

 

[T.Willey]

Thanks Ron and Kerry.  I like the fact that my skills have grown since belonging to this site.  I have seen and studied peoples code who I admire, and taken what I like from it.

Luis,

  Can you post a drawing of it not working?  Also what version are you testing it on?  I have toggled the angle on and off many times, and have not come across the issues you have.  It should always scale, but the style ( s ) and the angle ( a ) should always work.  Maybe the drawing you post will show me the issues you are having, so that we can get it fixed.

Andrea,

  I was thinking that, the option to toggle the scale.  I have it in mind already, so it should be an easy fix.  I thought about the orthomode, and was thinking about do it.  We shall see what I have time to add.     I'll look at your code when I get a chance.  Real work has been handed to me.

[Spike Wilbury]

Luis,

  Can you post a drawing of it not working?  Also what version are you testing it on?  I have toggled the angle on and off many times, and have not come across the issues you have.  It should always scale, but the style ( s ) and the angle ( a ) should always work.  Maybe the drawing you post will show me the issues you are having, so that we can get it fixed.

Tried with the last one posted here.

Select the hatch and see if works... I might say, it works in general, but after having or left a hatched area like the sample uploaded, it does not as far of my tests (or for me)

[T.Willey]

Luis,

  Can you post a drawing of it not working?  Also what version are you testing it on?  I have toggled the angle on and off many times, and have not come across the issues you have.  It should always scale, but the style ( s ) and the angle ( a ) should always work.  Maybe the drawing you post will show me the issues you are having, so that we can get it fixed.

Tried with the last one posted here.

Select the hatch and see if works... I might say, it works in general, but after having or left a hatched area like the sample uploaded, it does not as far of my tests (or for me)

It works Luis, but the scale factor is so large, and the area to hatch is so small, that you can't see the changes really.  Maybe if there is an option for a scale factor, so you can type a factor in, and it will divide the current scale amount by that factor.

[Spike Wilbury]

It works Luis, but the scale factor is so large, and the area to hatch is so small, that you can't see the changes really.  Maybe if there is an option for a scale factor, so you can type a factor in, and it will divide the current scale amount by that factor.

Don't worried, it is fine for me - don't know if I will use the tool.



I was doing the test, inside of a detail drawing (3"=1'-0")

As normal, keep doing the good stuff!

Thanks.

[CAB]

Some scales will cause problems with some patterns.
See attached my attempt to deal with the scale.
I made the Base Point offset by the scale factor so it doesn't start at zero.
Still have problems with some patterns where there range of usefull  scale is 0.1 to 2.
Also added a timer to detect pattern getting too dense.

Obviously you needent use any of this as I was just tinkering around.

[T.Willey]

It works Luis, but the scale factor is so large, and the area to hatch is so small, that you can't see the changes really.  Maybe if there is an option for a scale factor, so you can type a factor in, and it will divide the current scale amount by that factor.

Don't worried, it is fine for me - don't know if I will use the tool.



I was doing the test, inside of a detail drawing (3"=1'-0")

As normal, keep doing the good stuff!

Thanks.

I like a challenge Luis, so I had to figure out how to do it.  Now you can toggle the Scale ( s ), Angle ( a ), Scale factor ( f ) and the Pattern ( t ).  If you toggle off the scale and angle, then it will not draw the reference line ( but if you update the scale factor it will redraw the pattern ), so you can get a true look at your pattern.  I change the call to DHE ( dynamic hatch edit ).  Maybe orthomode next, or origin like Andrea is doing with his code.     We shall see.

I thing I don't like is how the prompt comes across.  I wanted to put it on two lines, but with prompt that wouldn't work with the ' \r ' switch.  I will see what I can find out later.  For now this is going in my code bag.   

Code: [Select]

(defun c:DHE ( / *error* GetHatchNames Sel Ent EntData oData nStyle cScale BasePt HatchList Pos
    TogAngle tempList tempPt tempData MaxPos TogScale ScFac )
    ; Dynamic Hatch Edit.  Scale, rotation and pattern.
   
    (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 "\n Select hatch to edit dynamicly: "))
            (setq oData (entget (car Sel)))
            (= (cdr (assoc 0 oData)) "HATCH")
            (setq nStyle (cdr (assoc 2 oData)))
            (setq cScale (cdr (assoc 41 oData)))
            (setq BasePt (cadr Sel))
            (setq HatchList
                (GetHatchNames
                    (if (zerop (getvar 'Measurement))
                        (findfile "acad.pat")
                        (findfile "acadiso.pat")
                    )
                )
            )
            (setq MaxPos (1- (length HatchList)))
            (setq Pos (vl-position nStyle HatchList))
            (setq TogScale 1)
            (setq TogAngle 0)
            (setq ScFac 1.)
        )
        (while
            (and
                (not
                    (prompt
                        (strcat
                            "\r Pattern: "
                            nStyle
                            " , Change angle: "
                            (if (zerop TogAngle) "No" "Yes")
                            " , Change scale: "
                            (if (zerop TogScale) "No" "Yes")
                            " , Scale factor: "
                            (rtos ScFac 2 4)
                            " [paTtern / Scale toggle / scale Factor / 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))
                    (if (not (zerop (distance tempPt BasePt))) ; <- Thanks to Alan ( CAB )
                        (progn
                            (redraw)
                            (if
                                (or
                                    (equal TogScale 1)
                                    (equal TogAngle 1)
                                )
                                (grdraw BasePt tempPt 7)
                            )
                            (setq tempData EntData)
                            (if (equal TogScale 1)
                                (setq tempData
                                    (subst
                                        (cons
                                            41
                                            ;(distance tempPt BasePt)
                                            (* (distance tempPt BasePt) cScale ScFac)
                                        )
                                        (assoc 41 tempData)
                                        tempData
                                    )
                                )
                            )
                            (if (equal TogAngle 1)
                                (setq tempData
                                    (subst
                                        (cons 52 (angle BasePt tempPt))
                                        (assoc 52 tempData)
                                        tempData
                                    )
                                )
                            )
                            (if (entmake tempData)
                                (progn
                                    (entdel Ent)
                                    (setq Ent (entlast))
                                )
                            )
                        )
                    )
                )
                ((equal (car tempList) 2)
                    (cond
                        ( (member (cadr tempList) '(84 116))
                            (if (equal Pos MaxPos)
                                (setq Pos 0)
                            )
                            (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)))
                        )
                        ( (member (cadr tempList) '(83 115))
                            (setq TogScale (abs (1- TogScale)))
                        )
                        ( (member (cadr tempList) '(40 102))
                            (setq ScFac
                                (cond
                                    ( (getreal (strcat "\n Enter scale factor <" (rtos ScFac 2 4) ">: ")) )
                                    (t ScFac)
                                )
                            )
                            (if
                                (entmake
                                    (subst
                                        (cons
                                            41
                                            ;(distance tempPt BasePt)
                                            (* (distance tempPt BasePt) cScale ScFac)
                                        )
                                        (assoc 41 EntData)
                                        EntData
                                    )
                                )
                                (progn
                                    (entdel Ent)
                                    (setq Ent (entlast))
                                )
                            )
                        )
                    )
                )
            )
        )
    )
    (redraw)
    (princ)
)


[T.Willey]

I like the ideas you have in your code Alan.  I was just trying to make it all one handed, so I can have my right hand on the mouse, and my left answering the prompts.  I have seen some of the problems with the scale being too small, so the timer is a good fix.  I will test more tomorrow when I get a chance.

[Andrea]

maybe by putting the CMDECHO to 0 you didn't see the

"Hatch boundary associativity removed." message..

(setvar "CMDECHO" 0)

 

by the way...DHE is more appropriate....I was thinking to rename the H.O.S. to Dhatch for DynamicHATCH or (the Hatch) 

[T.Willey]

I do see the message now.  I didn't know that they first tests I was doing was on non-associated hatches.  I will see if I can figure out how to keep them associated if they are.  Here is a new version that has the ortho honored, and a new prompt.  It will let you go forward or backward in the hatch patter list.  Options are now as followed; f = forward pattern, r = back ( reverse ) pattern, a = angle, s = scale, c = scale factor

Code: [Select]

(defun c:DHE ( / *error* GetHatchNames Sel Ent EntData oData nStyle cScale BasePt HatchList Pos
    TogAngle tempList tempPt tempData MaxPos TogScale ScFac TogOrtho Ang45 Ang135 Ang225 Ang315 )
    ; Dynamic Hatch Edit.  Scale, rotation and pattern.
   
    (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 "\n Select hatch to edit dynamicly: "))
            (setq oData (entget (car Sel)))
            (= (cdr (assoc 0 oData)) "HATCH")
            (setq nStyle (cdr (assoc 2 oData)))
            (setq cScale (cdr (assoc 41 oData)))
            (setq BasePt (cadr Sel))
            (setq HatchList
                (GetHatchNames
                    (if (zerop (getvar 'Measurement))
                        (findfile "acad.pat")
                        (findfile "acadiso.pat")
                    )
                )
            )
            (setq MaxPos (1- (length HatchList)))
            (setq Pos (vl-position nStyle HatchList))
            (setq TogScale 1)
            (setq TogAngle 0)
            (setq ScFac 1.)
            (setq TogOrtho (getvar 'OrthoMode))
            (setq Ang45 (* pi 0.25))
            (setq Ang135 (* pi 0.75))
            (setq Ang225 (* pi 1.25))
            (setq Ang315 (* pi 1.75))
        )
        (while
            (and
                (princ
                    (strcat
                        "\r pattern: "
                        nStyle
                        " [Forward / Reverse], change Angle: "
                        (if (zerop TogAngle) "No" "Yes")
                        " , change Scale: "
                        (if (zerop TogScale) "No" "Yes")
                        " , sCale factor: "
                        (rtos ScFac 2 4)
                    )
                )
                (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))
                    (setq tempAng (angle BasePt tempPt))
                    (setq tempAng
                        (if (zerop TogOrtho)
                            tempAng
                            (cond
                                (
                                    (or
                                        (<= tempAng Ang45)
                                        (>= tempAng Ang315)
                                    )
                                    0.0
                                )
                                ( (<= Ang45 tempAng Ang135)
                                    (* pi 0.5)
                                )
                                ( (<= Ang135 tempAng Ang225)
                                    pi
                                )
                                ( (<= Ang225 tempAng Ang315)
                                    (* pi 1.5)
                                )
                            )
                        )
                    )
                    (setq tempPt (polar BasePt tempAng (distance BasePt tempPt)))
                    (if (not (zerop (distance tempPt BasePt))) ; <- Thanks to Alan ( CAB )
                        (progn
                            (redraw)
                            (if
                                (or
                                    (equal TogScale 1)
                                    (equal TogAngle 1)
                                )
                                (grdraw BasePt tempPt 1 1)
                            )
                            (setq tempData EntData)
                            (if (equal TogScale 1)
                                (setq tempData
                                    (subst
                                        (cons
                                            41
                                            (* (distance tempPt BasePt) cScale ScFac)
                                        )
                                        (assoc 41 tempData)
                                        tempData
                                    )
                                )
                            )
                            (if (equal TogAngle 1)
                                (setq tempData
                                    (subst
                                        (cons 52 tempAng)
                                        (assoc 52 tempData)
                                        tempData
                                    )
                                )
                            )
                            (if (entmake tempData)
                                (progn
                                    (entdel Ent)
                                    (setq Ent (entlast))
                                )
                            )
                        )
                    )
                )
                ((equal (car tempList) 2)
                    (cond
                        ( (member (cadr tempList) '(40 102)) ; F pushed
                            (if (equal Pos MaxPos)
                                (setq Pos -1)
                            )
                            (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) '(82 114)) ; R pushed
                            (if (zerop Pos)
                                (setq Pos (1+ MaxPos))
                            )
                            (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)) ; A pushed
                            (setq TogAngle (abs (1- TogAngle)))
                        )
                        ( (member (cadr tempList) '(83 115)) ; S pushed
                            (setq TogScale (abs (1- TogScale)))
                        )
                        ( (member (cadr tempList) '(67 99)) ; C pushed
                            (setq ScFac
                                (cond
                                    ( (getreal (strcat "\n Enter scale factor <" (rtos ScFac 2 4) ">: ")) )
                                    (t ScFac)
                                )
                            )
                            (if
                                (entmake
                                    (subst
                                        (cons
                                            41
                                            (* (distance tempPt BasePt) cScale ScFac)
                                        )
                                        (assoc 41 EntData)
                                        EntData
                                    )
                                )
                                (progn
                                    (entdel Ent)
                                    (setq Ent (entlast))
                                )
                            )
                        )
                        ( (equal (cadr tempList) 15) ; F8 pushed
                            (setvar 'OrthoMode (setq TogOrtho (abs (1- TogOrtho))))
                        )
                    )
                )
            )
        )
    )
    (redraw)
    (princ)
)


[ronjonp]

Tim,

You could probably just make the hatch with the vl-functions after you get out of the grread and delete the last entmake hatch to make it associative.

*tested here and it worked

*nevermind...I forgot that you are editing existing hatch and not adding to an object

Ron

[T.Willey]

You did get me thinking though, but that idea didn't work either.  I tried to make the current hatch invisible, and then change it after all was done, but
' entmod ' still wouldn't work, even in '08.  I'll see if I can find a way after lunch.

[ronjonp]

Tim,

Something to mull over...I'm sure you can come up with a more elegant solution  but this worked for me:

Code: [Select]

(setq h (vlax-ename->vla-object (car (entsel))))

(setq obj (getassochatchobjs (car (entsel))))

(vl-catch-all-error-p
  (vl-catch-all-apply 'vlax-invoke
                      (list h 'appendouterloop obj)
  )
)


(defun getassochatchobjs (hatchent /)
  (mapcar 'vlax-ename->vla-object
          (mapcar 'cdr
                  (vl-remove-if-not
                    '(lambda (x)
                       (and (= 330 (car x))
                            (/= (cdr (assoc 0 (entget (cdr x)))) "BLOCK_RECORD")
                       )
                     )
                    (entget hatchent)
                  )
          )
  )
)


[T.Willey]

Ron,

  I was trying to do something like that with Lisp, and I could get it to work with polylines, but not with lines or circles, eventhough the code said it did.  I'll add this and see if it works.  I think it will.  I'm just being stubborn, and trying to use just vanilla Lisp.

Thanks.

[T.Willey]

That didn't seem to work for me Ron, I think I used it right, within the command, but it did from outside of it.  Not sure if it's an '06 thing or not.  Here is what I have so far, and I might work on it some more, but I might just leave it.  It seems to keep the associativeness with polylines ( closed tested only ), but nothing else.  I have not found a way to have it not assualt the command line with ' Hatch boundary associativity removed. ', which can take up the whole history.  Oh well.

Code: [Select]

(defun c:DHE ( / *error* GetHatchNames Sel Ent EntData oData nStyle cScale BasePt HatchList Pos
    TogAngle tempList tempPt tempData MaxPos TogScale ScFac TogOrtho Ang45 Ang135 Ang225 Ang315 )
    ; Dynamic Hatch Edit.  Scale, rotation and pattern.
   
    (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)
    )
    ;------------------------------------
    (defun UpdateHatchReactor ( ent oHatEnt nHatEnt / EntData EndList StList )
       
        (setq EntData (entget ent))
        (if (member (cons 330 oHatEnt) EntData)
            (entmod (subst (cons 330 nHatEnt) (cons 330 oHatEnt) EntData))
            (progn
                (setq EndList (member (assoc 5 EntData) EntData))
                (setq StList (reverse (member (car EndList) (reverse EntData))))
                (setq EndList (cdr EndList))
                (entmod
                    (append
                        StList
                        (append
                            (list
                                '(102 . "{ACAD_REACTORS")
                                (cons 330 nHatEnt)
                                '(102 . "}")
                            )
                            EndList
                        )
                    )
                )
            )
        )
    )
    ;------------------------------------
    (if
        (and
            (setq Sel (entsel "\n Select hatch to edit dynamicly: "))
            (setq oData (entget (car Sel)))
            (= (cdr (assoc 0 oData)) "HATCH")
            (setq nStyle (cdr (assoc 2 oData)))
            (setq cScale (cdr (assoc 41 oData)))
            (setq BasePt (cadr Sel))
            (setq HatchList
                (GetHatchNames
                    (if (zerop (getvar 'Measurement))
                        (findfile "acad.pat")
                        (findfile "acadiso.pat")
                    )
                )
            )
            (setq MaxPos (1- (length HatchList)))
            (setq Pos (vl-position nStyle HatchList))
            (setq TogScale 1)
            (setq TogAngle 0)
            (setq ScFac 1.)
            (setq TogOrtho (getvar 'OrthoMode))
            (setq Ang45 (* pi 0.25))
            (setq Ang135 (* pi 0.75))
            (setq Ang225 (* pi 1.25))
            (setq Ang315 (* pi 1.75))
        )
        (progn
            (while
                (and
                    (princ
                        (strcat
                            "\r pattern: "
                            nStyle
                            " [Forward / Reverse], change Angle: "
                            (if (zerop TogAngle) "No" "Yes")
                            " , change Scale: "
                            (if (zerop TogScale) "No" "Yes")
                            " , sCale factor: "
                            (rtos ScFac 2 4)
                        )
                    )
                    (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))
                        (setq tempAng (angle BasePt tempPt))
                        (setq tempAng
                            (if (zerop TogOrtho)
                                tempAng
                                (cond
                                    (
                                        (or
                                            (<= tempAng Ang45)
                                            (>= tempAng Ang315)
                                        )
                                        0.0
                                    )
                                    ( (<= Ang45 tempAng Ang135)
                                        (* pi 0.5)
                                    )
                                    ( (<= Ang135 tempAng Ang225)
                                        pi
                                    )
                                    ( (<= Ang225 tempAng Ang315)
                                        (* pi 1.5)
                                    )
                                )
                            )
                        )
                        (setq tempPt (polar BasePt tempAng (distance BasePt tempPt)))
                        (if (not (zerop (distance tempPt BasePt))) ; <- Thanks to Alan ( CAB )
                            (progn
                                (redraw)
                                (if
                                    (or
                                        (equal TogScale 1)
                                        (equal TogAngle 1)
                                    )
                                    (grdraw BasePt tempPt 1 1)
                                )
                                (setq tempData EntData)
                                (if (equal TogScale 1)
                                    (setq tempData
                                        (subst
                                            (cons
                                                41
                                                (* (distance tempPt BasePt) cScale ScFac)
                                            )
                                            (assoc 41 tempData)
                                            tempData
                                        )
                                    )
                                )
                                (if (equal TogAngle 1)
                                    (setq tempData
                                        (subst
                                            (cons 52 tempAng)
                                            (assoc 52 tempData)
                                            tempData
                                        )
                                    )
                                )
                                (if (entmake tempData)
                                    (progn
                                        (entdel Ent)
                                        (setq Ent (entlast))
                                    )
                                )
                            )
                        )
                    )
                    ((equal (car tempList) 2)
                        (cond
                            ( (member (cadr tempList) '(40 102)) ; F pushed
                                (if (equal Pos MaxPos)
                                    (setq Pos -1)
                                )
                                (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) '(82 114)) ; R pushed
                                (if (zerop Pos)
                                    (setq Pos (1+ MaxPos))
                                )
                                (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)) ; A pushed
                                (setq TogAngle (abs (1- TogAngle)))
                            )
                            ( (member (cadr tempList) '(83 115)) ; S pushed
                                (setq TogScale (abs (1- TogScale)))
                            )
                            ( (member (cadr tempList) '(67 99)) ; C pushed
                                (setq ScFac
                                    (cond
                                        ( (getreal (strcat "\n Enter scale factor <" (rtos ScFac 2 4) ">: ")) )
                                        (t ScFac)
                                    )
                                )
                                (if
                                    (entmake
                                        (subst
                                            (cons
                                                41
                                                (* (distance tempPt BasePt) cScale ScFac)
                                            )
                                            (assoc 41 EntData)
                                            EntData
                                        )
                                    )
                                    (progn
                                        (entdel Ent)
                                        (setq Ent (entlast))
                                    )
                                )
                            )
                            ( (equal (cadr tempList) 15) ; F8 pushed
                                (setvar 'OrthoMode (setq TogOrtho (abs (1- TogOrtho))))
                            )
                        )
                    )
                )
            )
            (setq Ent (entlast))
            (foreach i (cdr (member '(100 . "AcDbHatch") (entget Ent)))
                (if (equal (type (cdr i)) 'ENAME)
                    (UpdateHatchReactor (cdr i) (cdr (assoc -1 oData)) Ent)
                    ;(setq EntList (cons (cdr i) EntList))
                )
            )
            ;|
            (if EntList
                (vlax-invoke (vlax-ename->vla-object Ent) 'AppendOuterLoop (apply 'vlax-ename->vla-object EntList))
            )
            (setq EntList nil)|;
        )
    )
    (redraw)
    (princ)
)


[CAB]

Worked well here Tim with ACAD2000 & no message 'Hatch boundary associativity removed'

[Andrea]

tested on 2009..

[Andrea]

tested on 2009 with CMDECHO set to 0..

[Andrea]

For comment..

I've made some test on 2009.

- Rotation do also a scale..
- Rotation do not alway follow the hatch pattern
- Scale do also a rotation.
- ORTHO work only 0 90 180 180 and do not follow the SNAPANG variable.

don't know if it is the same on older release..

[T.Willey]

Thanks for testing Alan.  Good to hear it works there.

Andrea,

  I thought about following the SnapAng variable, but didn't do it just because I don't change it very often.  That shouldn't get a change too hard to make though.  I'll see about adding it.

[ronjonp]

For comment..

I've made some test on 2009.

- Rotation do also a scale..
- Rotation do not alway follow the hatch pattern
- Scale do also a rotation.
- ORTHO work only 0 90 180 180 and do not follow the SNAPANG variable.

don't know if it is the same on older release..

FWIW...Tim I do not see any of these issues in 09 everything appears to work fine. The only drawback is the non-assoc hatch created with objects other that a polyline.

Ron





[/quote]

[T.Willey]

Thanks Ron.