Author Topic: H.O.S.E. problem  (Read 10791 times)

0 Members and 1 Guest are viewing this topic.

T.Willey

  • Needs a day job
  • Posts: 5251
H.O.S.E. problem
« on: December 17, 2008, 07:09:41 PM »
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)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Andrea

  • Water Moccasin
  • Posts: 2372
Re: H.O.S.E. problem
« Reply #1 on: December 17, 2008, 07:50:21 PM »
wow..nice work.

it work just fine here..
Keep smile...

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: H.O.S.E. problem
« Reply #2 on: December 17, 2008, 08:20:16 PM »

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 ]
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: H.O.S.E. problem
« Reply #3 on: December 17, 2008, 08:34:43 PM »
Works fine here. Nice job :)
I was throwing something together as well for fun. I'll post it tomorrow.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

T.Willey

  • Needs a day job
  • Posts: 5251
Re: H.O.S.E. problem
« Reply #4 on: December 18, 2008, 10:58:10 AM »
Thanks guys for testing, and letting me know I'm crazy.  :-D  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
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: H.O.S.E. problem
« Reply #5 on: December 18, 2008, 11:07:48 AM »
...
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 :)
« Last Edit: December 18, 2008, 11:11:45 AM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

T.Willey

  • Needs a day job
  • Posts: 5251
Re: H.O.S.E. problem
« Reply #6 on: December 18, 2008, 11:20:47 AM »
...
*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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: H.O.S.E. problem
« Reply #7 on: December 18, 2008, 12:38:08 PM »
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.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: H.O.S.E. problem
« Reply #8 on: December 18, 2008, 12:46:49 PM »
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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: H.O.S.E. problem
« Reply #9 on: December 18, 2008, 03:39:38 PM »
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)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: H.O.S.E. problem
« Reply #10 on: December 18, 2008, 03:50:52 PM »
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.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: H.O.S.E. problem
« Reply #11 on: December 18, 2008, 04:41:01 PM »
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.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: H.O.S.E. problem
« Reply #12 on: December 18, 2008, 05:05:48 PM »
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)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: H.O.S.E. problem
« Reply #13 on: December 18, 2008, 05:12:17 PM »
Seems to work here...nice code :) as usual

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: H.O.S.E. problem
« Reply #14 on: December 18, 2008, 05:16:41 PM »
nice looking logic map Tim ...

evolution is great !
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.