Author Topic: Add Dtext to get Total  (Read 4750 times)

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2021
Re: Add Dtext to get Total
« Reply #30 on: July 30, 2009, 05:47:04 PM »
I think my version solved that problem. No?


Nope.

Only mine.... I win.... :-)

Nope, still same problem...
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2019x64 Windows 10x64

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Add Dtext to get Total
« Reply #31 on: July 30, 2009, 05:51:55 PM »
Thanks for the pointers Alan  :-)

How 'bout this approach:

Code: [Select]
;;  By Lee
;;  Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
  (vl-load-com)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (setq doc (vla-get-ActiveDocument
                  (vlax-get-Acad-Object))
            spc (if (zerop (vla-get-activespace doc))
                  (if (= (vla-get-mspace doc) :vlax-true)
                    (vla-get-modelspace doc)
                    (vla-get-paperspace doc))
                  (vla-get-modelspace doc)))
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
        (setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
      (setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
      (setq tObj (vla-addText spc tStr (vlax-3d-point '(0 0 0))
                     (*(getvar "DIMSCALE")(getvar "DIMTXT"))))
      (vla-put-Alignment tObj acAlignmentMiddleCenter)
      (while
        (progn
          (setq gr (grread 't 5 0))
          (cond ((eq 5 (car gr))
                 (vla-put-TextAlignmentPoint tObj
                   (vlax-3D-point (trans (cadr gr) 1 0))) t)
                (t nil))))))
  (princ))

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Add Dtext to get Total
« Reply #32 on: July 30, 2009, 05:52:18 PM »
I think my version solved that problem. No?


Nope.

Only mine.... I win.... :-)

Nope, still same problem...

Did you change the ' while ' line in Lee's code to mine?  It worked here once I did that.
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: 5218
Re: Add Dtext to get Total
« Reply #33 on: July 30, 2009, 05:54:03 PM »
Try this.

Code: [Select]
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
  (vl-load-com)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (setq doc (vla-get-ActiveDocument
                  (vlax-get-Acad-Object))
            spc (if (zerop (vla-get-activespace doc))
                  (if (= (vla-get-mspace doc) :vlax-true)
                    (vla-get-modelspace doc)
                    (vla-get-paperspace doc))
                  (vla-get-modelspace doc)))
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
        (setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
      (setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
      (princ "\nText About to be Placed.")
      (vla-put-Alignment
        (setq tObj (vla-addText spc tStr
                     (vla-getVariable doc "VIEWCTR")
                     (*(getvar "DIMSCALE")(getvar "DIMTXT"))))
        acAlignmentMiddleCenter)
      (princ "\nGrRead commences here. ")
[color=red]      (while (not (eq 3 (car (setq gr (grread 't 5 0)))))[/color]
        (vla-move tObj
          (vla-get-TextAlignmentPoint tObj)
                  (vlax-3D-point (trans (cadr gr) 1 0))))
      (princ "\nGrRead Complete.")
      (vla-delete sel)))
  (princ))
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: 10376
Re: Add Dtext to get Total
« Reply #34 on: July 30, 2009, 05:55:18 PM »
Tim, did you try my version?

It will exit with left or right click or Enter. The text is updated to the last known cursor position.
Mine doesn't work for you?
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.

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Add Dtext to get Total
« Reply #35 on: July 30, 2009, 05:56:33 PM »
Could it be the varying speeds of our PC's that are affecting this? If the grread is being evaluated too quickly after the ssget input is completed, meaning that the right-click or enter is being swept into the grread loop?

Just a theory :P

Spike Wilbury

  • Guest
Re: Add Dtext to get Total
« Reply #36 on: July 30, 2009, 05:59:00 PM »
Tim,

just tried the routine and returns this:

DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13

if I hit enter

(so please return the prize that was given away of $100,000,000 swamp dollars  :-P)

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Add Dtext to get Total
« Reply #37 on: July 30, 2009, 06:00:42 PM »
Tim, did you try my version?

It will exit with left or right click or Enter. The text is updated to the last known cursor position.
Mine doesn't work for you?

The latest one didn't work unless I hit enter or the space bar.  If I use the right click to end the ssget call, then it would just place it at 0,0.

Could it be the varying speeds of our PC's that are affecting this? If the grread is being evaluated too quickly after the ssget input is completed, meaning that the right-click or enter is being swept into the grread loop?

Just a theory :P

That is what I was thinking.  That is why I changed it the way I did, so it will only exit once you pick a point, instead of stop moving the mouse.  Yours would stop if you hit any button while moving the text.
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: 5218
Re: Add Dtext to get Total
« Reply #38 on: July 30, 2009, 06:02:33 PM »
Tim,

just tried the routine and returns this:

DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13

if I hit enter

(so please return the prize that was given away of $100,000,000 swamp dollars  :-P)

Hey!!  That wasn't the issue, therefore should not affect my winning... that is a whole new problem by the way it is coded..... :oops:
Tim

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

Please think about donating if this post helped you.

Spike Wilbury

  • Guest
Re: Add Dtext to get Total
« Reply #39 on: July 30, 2009, 06:04:12 PM »
Tim,

just tried the routine and returns this:

DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13

if I hit enter

(so please return the prize that was given away of $100,000,000 swamp dollars  :-P)

Hey!!  That wasn't the issue, therefore should not affect my winning... that is a whole new problem by the way it is coded..... :oops:

:)

if i run the first one posted by Lee... it works here using A2009

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Add Dtext to get Total
« Reply #40 on: July 30, 2009, 06:05:50 PM »
Tim,

just tried the routine and returns this:

DPICK
Select objects: 1 found
Select objects:
Text About to be Placed.
GrRead commences here. ; error: bad argument type: 2D/3D point: 13

if I hit enter

(so please return the prize that was given away of $100,000,000 swamp dollars  :-P)

Hey!!  That wasn't the issue, therefore should not affect my winning... that is a whole new problem by the way it is coded..... :oops:

:)

if i run the first one posted by Lee... it works here using A2009

Even if you right click to end the text selection?  I didn't test it in my '09, only '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: 10376
Re: Add Dtext to get Total
« Reply #41 on: July 30, 2009, 06:08:58 PM »

One more 8-)
Code: [Select]
;;  By Lee
;;  Sum the text selected & add new text with the total
(defun c:dPick (/ ss doc spc sel lst tStr tObj gr)
  (vl-load-com)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (setq doc (vla-get-ActiveDocument
                  (vlax-get-Acad-Object))
            spc (if (zerop (vla-get-activespace doc))
                  (if (= (vla-get-mspace doc) :vlax-true)
                    (vla-get-modelspace doc)
                    (vla-get-paperspace doc))
                  (vla-get-modelspace doc)))
      (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
        (setq lst (cons (distof (vla-get-TextString Obj) 4) lst)))
      (setq tStr (rtos (apply '+ (vl-remove-if 'null lst)) 4 2))
      (setq tObj (vla-addText spc tStr (vlax-3d-point '(0 0 0))
                     (*(getvar "DIMSCALE")(getvar "DIMTXT"))))
      (vla-put-Alignment tObj acAlignmentMiddleCenter)
      (while (and(/= 3 (car (setq gr (grread 't 5 0)))) (listp (cadr gr)))
          (vla-put-TextAlignmentPoint tObj (vlax-3D-point (trans (cadr gr) 1 0)))
      )
    ))
  (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.

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Add Dtext to get Total
« Reply #42 on: July 30, 2009, 06:10:11 PM »
Thanks a winner Alan!!!!  You can have my prize...  :oops:
Tim

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

Please think about donating if this post helped you.

Spike Wilbury

  • Guest
Re: Add Dtext to get Total
« Reply #43 on: July 30, 2009, 06:12:09 PM »
Even if you right click to end the text selection?  I didn't test it in my '09, only '06.

yep... right,left or enter works

CAB

  • Global Moderator
  • Seagull
  • Posts: 10376
Re: Add Dtext to get Total
« Reply #44 on: July 30, 2009, 06:17:29 PM »
Too much virtual beer I think.  8-)
Off to play some tennis if this rain will hold off.
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.