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

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2021
Re: Add Dtext to get Total
« Reply #15 on: July 30, 2009, 11:27:29 AM »
Lee

I could not get yours to work in placing the new dtext total in the drawing.

Hmmm... Seems to work fine for me  :?



I'm using version 2008 and 2010


Command: dpick

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects:

Command:


The routine just stops without placing any text.
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2019x64 Windows 10x64

GDF

  • Water Moccasin
  • Posts: 2021
Re: Add Dtext to get Total
« Reply #16 on: July 30, 2009, 11:34:55 AM »
Lee

Never mind. It works but it placed the text way off or at the first text selected.
Thanks for sharing it.

Alan

I did a search first before I posted. I remember your routine now. I need to learn how to do a proper search.
Thanks for sharing your routine to.
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 #17 on: July 30, 2009, 11:36:38 AM »
Lee

Never mind. It works but it placed the text way off or at the first text selected.
Thanks for sharing it.

I'm not sure why that would be, but oh well.  :-)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10376
Re: Add Dtext to get Total
« Reply #18 on: July 30, 2009, 11:59:34 AM »
Maybe a trans would help? [Throwing Darts]
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))
      (vla-put-Alignment
        (setq tObj (vla-addText spc tStr
                     (vla-getVariable doc "VIEWCTR")
                     (*(getvar "DIMSCALE")(getvar "DIMTXT"))))
        acAlignmentMiddleCenter)
      (while (eq 5 (car (setq gr (grread 't 5 0))))
        (vla-move tObj
          (vla-get-TextAlignmentPoint tObj) (vlax-3D-point ([color=red]trans[/color] (cadr gr) 1 0))))
      (vla-delete sel)))
  (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.

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Add Dtext to get Total
« Reply #19 on: July 30, 2009, 12:16:40 PM »
Yeah, nice idea Alan, could well be that  :-)

GDF

  • Water Moccasin
  • Posts: 2021
Re: Add Dtext to get Total
« Reply #20 on: July 30, 2009, 03:25:14 PM »
Yeah, nice idea Alan, could well be that  :-)

Alan

Lee's routine and your fix still will not let me pick the location for the new added text. The text jumps to 0,0.
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 #21 on: July 30, 2009, 03:44:38 PM »
I can't understand that.

My routine just adds the Text using at the point defined by the VIEWCTR sys var, then moves this text using mouse positions retrieved through the GrRead loop - I can't see where it is failing...   :|

As an error catching exercise, what does your command line look like after running this?

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))
      (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. ")
      (while (eq 5 (car (setq gr (grread 't 5 0))))
        (vla-move tObj
          (vla-get-TextAlignmentPoint tObj)
                  (vlax-3D-point (trans (cadr gr) 1 0))))
      (princ "\nGrRead Complete.")
      (vla-delete sel)))
  (princ))

GDF

  • Water Moccasin
  • Posts: 2021
Re: Add Dtext to get Total
« Reply #22 on: July 30, 2009, 05:13:37 PM »
Command: (LOAD "E:/Arch_WorkOn/architettura/dpick2.lsp") C:DPICK

Command: dpick

Select objects: 1 found

Select objects: 1 found, 2 total

Select objects:

Text About to be Placed.
GrRead commences here.
GrRead Complete.

Command:





The routine will still not let me place the dtext. THe routine places it at 0,0 still.
« Last Edit: July 30, 2009, 05:16:46 PM by GDF »
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 #23 on: July 30, 2009, 05:21:38 PM »
That is crazy... no errors whatsoever, and yet, I cannot get it to fail here  :-(

T.Willey

  • Needs a day job
  • Posts: 5218
Re: Add Dtext to get Total
« Reply #24 on: July 30, 2009, 05:27:48 PM »
Happens here the same as Gary pretty much.  Once you select the text, the code ends, and the new text is placed at 0,0

Quote
DPICK
Select objects: Specify opposite corner: 4 found

Select objects:

Text About to be Placed.
GrRead commences here.
GrRead Complete.
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 #25 on: July 30, 2009, 05:33:41 PM »
Another version to test:
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 (eq 5 (car (setq gr (grread 't 5 0))))
          (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 #26 on: July 30, 2009, 05:36:41 PM »
The problem seems to be with the grread loop.  Exit the selection with hitting the right click, and then exit hitting enter.  If I hit enter I can see the text, and place it, but if I hit the right click, then it just places.

edit:  Added code to show what works here

Code: [Select]
      (while (not (eq 3 (car (setq gr (grread 't 5 0)))))
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 #27 on: July 30, 2009, 05:36:52 PM »
Lee, no need to position the new text other than '(0 0) as it will only remain there a nano second. :)
No need for the MOVE, just update the text object position.
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: 10376
Re: Add Dtext to get Total
« Reply #28 on: July 30, 2009, 05:38:33 PM »
I think my version solved that problem. No?
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 #29 on: July 30, 2009, 05:44:52 PM »
I think my version solved that problem. No?


Nope.

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

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

Please think about donating if this post helped you.