Author Topic: Elevating Flat Polylines to Close Numeric Text Value  (Read 6084 times)

0 Members and 1 Guest are viewing this topic.

xiaxiang

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #15 on: November 23, 2010, 03:32:00 AM »
The command is AeccMoveTextToElevation.

If I'm home, I'll try to upload the tool.
Hurry up,and I couldn't wait  :-P

mjfarrell

  • Seagull
  • Posts: 14444
  • Every Student their own Lesson
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #16 on: November 23, 2010, 07:34:40 AM »
In Civil3D there is a command for doing that, and you don't have to use queries and textfiles.

, though in Civil3D there is an option to use proximity breaklines which will do the same, as long as there are 3D points above the nodes.


To use AeccMoveTextToElevation the actual COMMAND Line entry is MoveTextToElevation. I'm not sure if this command is available outside of C3D.



As for using 'proximity' breaklines, which I advise against because it assigns what ever elevation to the vertices, from whatever point is proximal to that point.  The points do not need to be exactly at the vertex.

« Last Edit: November 23, 2010, 07:48:30 AM by Anti Quark »
Be your Best


Michael Farrell
http://primeservicesglobal.com/

CAB

  • Global Moderator
  • Seagull
  • Posts: 10376
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #17 on: November 23, 2010, 09:36:51 AM »
Quick look and I made a few changes but not much change in speed I suspect.  See ; CAB for changes.
Will look again after breakfast to see what this routine is doing.
Code: [Select]
(defun ssget->vla-list (ss / i ename allobj)
  (if ss
    (progn
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
        (setq allobj (cons (vlax-ename->vla-object ename) allobj))
      )
      allobj
    )
  )
)

(defun c:autoelevate (/         linework  number    ent       elist     elevat
                      circle    *Space*   newradius numlines  ActDoc    bb
                      pt1       pt2       insxpt    midpoint  radius    increment
                      count     skipped   maxrad    inc
                     )
  (vl-load-com)
  (setq ActDoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq *Space* (vlax-get-property
                  ActDoc
                  (nth (vla-get-activespace ActDoc) '("PaperSpace" "ModelSpace"))
                )
  )
  (vla-endundomark ActDoc)
  (vla-startundomark ActDoc)
  (setq radius (getreal "\nEnter starting radius:"))
  (while (or (null radius) (<= radius 0))
    (setq radius (getreal "\nEnter starting radius greater than 0:"))
  )
  (setq increment (getreal "\nEnter radius increment:"))
  (while (or (null increment) (<= increment 0))
    (setq increment (getreal "\nEnter radius increment greater than 0:"))
  )
  (setq maxrad (getreal "\nEnter maximum radius:"))
  (while (or (null maxrad) (< maxrad radius))
    (setq maxrad (getreal "\nEnter maximum (greater than radius):"))
  )
  (setq count 0
        skipped 0
  )

  (vlax-for i (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
    (if (vl-position (vla-get-objectname i) '("AcDbMText" "AcDbText")) ; CAB
      (progn
        (vl-catch-all-apply
          'vla-getboundingbox
          (list i
                'minpoint
                'maxpoint
          )
        )
        (setq pt1       (vlax-safearray->list minpoint)
              pt2       (vlax-safearray->list maxpoint)
              midpoint  (mapcar (function (lambda (a b) (/ (+ a b) 2.0))) pt1 pt2) ; CAB
              inc       (/ (* pi 2) 10)
              newradius radius
              elevat    nil
        )

        (while (and elevat (<= newradius maxrad)) ; CAB
          (setq plist nil
                n 0
          )
         
          (while (<  (setq n (1+ n)) 12)  ; CAB
            (setq plist (append plist (list (polar midpoint (* inc n) newradius))))
          )
         
          (setq newradius (+ newradius increment))
          (and
            (setq linework
                   (ssget->vla-list
                     (ssget "_CP"
                            plist
                            (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,ELLIPSE"))
                     )
                   )
            )
            (setq number (vla-get-textstring i)
                  elevat (atoi number)
            )
            (eq (vla-get-elevation (car linework)) 0.0) ; CAB
            (not (vla-put-elevation (car linework) elevat)) ; CAB
            (setq count (1+ count))
            (grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
          )                             ;and
        )                               ;while
      )                                 ;progn
    )                                   ;if
  )                                     ;vlax-for

  (vla-endundomark ActDoc)
  (princ (strcat "\nProcess Complete..." (itoa count) " Flat Segments Elevated."))
  (princ)
)                                       ;defun autoelevate
(defun c:aev () (c:autoelevate))
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.

alanjt

  • Needs a day job
  • Posts: 5327
  • Standby for witty remark...
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #18 on: November 23, 2010, 10:06:04 AM »
To use AeccMoveTextToElevation the actual COMMAND Line entry is MoveTextToElevation. I'm not sure if this command is available outside of C3D.
For those without C3D...

Code: [Select]
(defun c:MoveTextToElevation (/ ss z)
  (vl-load-com)
  (if (setq ss (ssget "_:L" '((0 . "MTEXT,TEXT"))))
    (progn
      (vlax-for x (setq ss (vla-get-activeselectionset
                             (cond (*AcadDoc*)
                                   ((setq *AcadDoc* (vla-get-activedocument
                                                      (vlax-get-acad-object)
                                                    )
                                    )
                                   )
                             )
                           )
                  )
        (if (setq z (distof (vla-get-textstring x)))
          (vlax-put x
                    'InsertionPoint
                    (reverse (cons z (cdr (reverse (vlax-get x 'InsertionPoint)))))
          )
        )
      )
      (vla-delete ss)
    )
  )
  (princ)
)
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

CAB

  • Global Moderator
  • Seagull
  • Posts: 10376
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #19 on: November 23, 2010, 10:41:04 AM »
jv
Looking at the code I see this:
Quote
Step trough model space objects, process Text or Mtext objects only
Use BB to get the middle point of the text
Create a point list to circle the text center at each radius, up to MaxRadius
Use ssget CP to gather any objects (see types list) within or crossing that raidus
Update the first one (closest one?) to the desired elevation
 why only the first object in the SS ?
You should end the WHILE loop at this point, but it continues on
Or do you want it to continue on?
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.

jvillarreal

  • Bull Frog
  • Posts: 313
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #20 on: November 23, 2010, 10:54:37 AM »
Cab,
The reason it only updates the first one is because its intended to only grab the closest object. If it grabs more than one, the increment or starting radius should probably have been decreased. On the version i posted, the while loop ends when an elevation is extracted from a text object or the max radius is reached.
Thanks for looking at this.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10376
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #21 on: November 23, 2010, 11:03:19 AM »
Problem is that i is set outside the WHILE loop and never changes to end the loop.

See in this one I end the while loop by setting elevat to nil
Code: [Select]
(defun ssget->vla-list (ss / i ename allobj)
  (if ss
    (progn
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
        (setq allobj (cons (vlax-ename->vla-object ename) allobj))
      )
      allobj
    )
  )
)

(defun c:autoelevate (/         linework  number    ent       elist     elevat
                      circle    *Space*   newradius numlines  ActDoc    bb
                      pt1       pt2       insxpt    midpoint  radius    increment
                      count     skipped   maxrad    inc
                     )
  (vl-load-com)
  (setq ActDoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq *Space* (vlax-get-property
                  ActDoc
                  (nth (vla-get-activespace ActDoc) '("PaperSpace" "ModelSpace"))
                )
  )
  (vla-endundomark ActDoc)
  (vla-startundomark ActDoc)
  (setq radius (getreal "\nEnter starting radius:"))
  (while (or (null radius) (<= radius 0))
    (setq radius (getreal "\nEnter starting radius greater than 0:"))
  )
  (setq increment (getreal "\nEnter radius increment:"))
  (while (or (null increment) (<= increment 0))
    (setq increment (getreal "\nEnter radius increment greater than 0:"))
  )
  (setq maxrad (getreal "\nEnter maximum radius:"))
  (while (or (null maxrad) (< maxrad radius))
    (setq maxrad (getreal "\nEnter maximum (greater than radius):"))
  )
  (setq count 0
        skipped 0
  )
;|
Step through model space objects, process Text or Mtext objects only
Use BB to get the middle point of the text
Create a point list to circle the text center at each radius, up to MaxRadius
Use ssget CP to gather any objects (see types list) within or crossing that raidus
Update the first one (closest one?) to the desired elevation
You should end the WHILE loop at this point, but it continues on
Or do you want it to continue on?
|;
  (vlax-for i (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
    (if (vl-position (vla-get-objectname i) '("AcDbMText" "AcDbText")) ; CAB
      (progn
        (vl-catch-all-apply
          'vla-getboundingbox
          (list i
                'minpoint
                'maxpoint
          )
        )
        (setq pt1       (vlax-safearray->list minpoint)
              pt2       (vlax-safearray->list maxpoint)
              midpoint  (mapcar (function (lambda (a b) (/ (+ a b) 2.0))) pt1 pt2) ; CAB
              inc       (/ (* pi 2) 10)
              newradius radius
              elevat    nil
        )

        ;;  This does not change in the WHILE loop
            (setq number (vla-get-textstring i) ; CAB relocated
                  elevat (atoi number)
            )


        ;;  ---------------------------------------------------  Main Loop
        
        (while (and elevat (<= newradius maxrad)) ; CAB
          (setq plist nil
                n 0
          )
          
          (while (<  (setq n (1+ n)) 12)  ; CAB
            (setq plist (cons (list (polar midpoint (* inc n) newradius)) plist)) ; CAB remove append
          )
          
          (setq newradius (+ newradius increment))
          (and
            (setq linework
                   (ssget->vla-list
                     (ssget "_CP"
                            plist
                            (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,ELLIPSE"))
                     )
                   )
            )

            ;;  why only the first object in the SS ?
            (eq (vla-get-elevation (car linework)) 0.0) ; CAB
            (not (vla-put-elevation (car linework) elevat)) ; CAB
            (not (setq elevat nil)) ; end while loop ; CAB
            (setq count (1+ count))
            (grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
          )                             ;and
        )                               ;while
        ;; ----------------------------------------------------  Main Loop
        
      )                                 ;progn
    )                                   ;if
  )                                     ;vlax-for

  (vla-endundomark ActDoc)
  (princ (strcat "\nProcess Complete..." (itoa count) " Flat Segments Elevated."))
  (princ)
)                                       ;defun autoelevate
(defun c:aev () (c:autoelevate))
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.

jvillarreal

  • Bull Frog
  • Posts: 313
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #22 on: November 23, 2010, 11:11:47 AM »
Quote
Problem is that i is set outside the WHILE loop and never changes to end the loop.
Code: [Select]
(while[color=red] (and (<= newradius maxrad)(null elevat))[/color]    (setq plist nil n 0)
    (while (<= n 10)
           (setq n (1+ n)
                 plist (append plist (list (polar midpoint (* inc n) newradius)))
           )
    )
    (setq newradius (+ newradius increment))
    (and
     (setq linework
       (ssget->vla-list
         (ssget "_CP" plist (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,ELLIPSE")))))
[color=red]     (setq number (vla-get-textstring i)
           elevat (atoi number)
     )[/color]
     (eq (vla-get-elevation (nth 0 linework)) 0.0)
     (not (vla-put-elevation (nth 0 linework) elevat))
     (setq count (1+ count))
     (grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
    );and
   );while


The while loop is ended after elevat is set so i don't think the while loop is an issue
« Last Edit: November 23, 2010, 11:18:32 AM by jvillarreal »

jvillarreal

  • Bull Frog
  • Posts: 313
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #23 on: November 23, 2010, 11:26:19 AM »
I apologize for the slow responses. My current connection speed is very slow.
The while loop  shouldn't affect the speed as the original while loop ends after a selection is made as i've shown in the previous post.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10376
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #24 on: November 23, 2010, 11:33:04 AM »
Show me where in the WHILE loop the variable i changes.

If you step through the while loop you will see that
Code: [Select]
    (setq number (vla-get-textstring i)
           elevat (atoi number)
     )
Never changes the value elevat, it just keeps setting it to the same value because I never changes.
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.

jvillarreal

  • Bull Frog
  • Posts: 313
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #25 on: November 23, 2010, 11:40:55 AM »
Foreach text entity in modelspace, elevat is set to nil and the while loop is run until elevat is set or the max radius is reached. Elevat is only set when a selection is made. Once elevat is set, the elevation of the first object in the selection set is changed and the process is repeated for the next text entity.

Code: [Select]
(vlax-for i (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 (if (member (vla-get-objectname i) '("AcDbMText" "AcDbText"))
  (progn
   (vl-catch-all-apply 'vla-getboundingbox
    (list i
     'minpoint
     'maxpoint
    )
   )
   (setq pt1 (vlax-safearray->list minpoint)
         pt2 (vlax-safearray->list maxpoint)
         midpoint (mapcar '(lambda (a b) (/ (+ a b) 2.0)) pt1 pt2)
         inc (/ (* pi 2) 10)
         newradius radius
         [color=red]elevat nil[/color])

   (while [color=red](and (<= newradius maxrad)(null elevat))[/color]
    (setq plist nil n 0)
    (while (<= n 10)
           (setq n (1+ n)
                 plist (append plist (list (polar midpoint (* inc n) newradius)))
           )
    )
    (setq newradius (+ newradius increment))
    [color=red](and
     (setq linework
       (ssget->vla-list
         (ssget "_CP" plist (list (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,ELLIPSE")))))
     (setq number (vla-get-textstring i)
           elevat (atoi number)
     )[/color]
     (eq (vla-get-elevation (nth 0 linework)) 0.0)
     (not (vla-put-elevation (nth 0 linework) elevat))
     (setq count (1+ count))
     (grtext -2 (strcat (itoa count) " Flat Segments Elevated."))
    );and
   );while
  );progn
 );if
);vlax-for

« Last Edit: November 23, 2010, 11:45:36 AM by jvillarreal »

Robert98

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #26 on: November 23, 2010, 11:44:55 AM »
Show me where in the WHILE loop the variable i changes.

If you step through the while loop you will see that
Code: [Select]
    (setq number (vla-get-textstring i)
           elevat (atoi number)
     )
Never changes the value elevat, it just keeps setting it to the same value because I never changes.

Hi dear CAB and Alanjt
Very nice And quite elaborate. ,You're a real genius in autocad programming ...!?
I have some guests and must go to drink ... so Goodbye to you again :wink:

Thanks and I hope you always happy

jvillarreal

  • Bull Frog
  • Posts: 313
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #27 on: November 23, 2010, 11:53:29 AM »
Cab, i'm still a beginner in writing lisp routines and appreciate any advice you have for me. Am i missing something in the way one of these functions works?
The while loop SHOULD stop running when elevat is set and continue to the next entity in my example shouldn't it?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10376
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #28 on: November 23, 2010, 12:02:47 PM »
Foreach text entity in modelspace, elevat is set to nil and the while loop is run until elevat is set or the max radius is reached. Elevat is only set when a selection is made. Once elevat is set, the elevation of the first object in the selection set is changed and the process is repeated for the next text entity.

Ah yes, I see it now, Thanks.
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.

jvillarreal

  • Bull Frog
  • Posts: 313
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #29 on: November 23, 2010, 12:09:41 PM »
Thanks again for looking at it Cab. I'll implement all other changes you made in my copy at work.