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

0 Members and 1 Guest are viewing this topic.

huiz

  • Swamp Rat
  • Posts: 870
  • Certified Prof C3D
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #30 on: November 23, 2010, 02:10:20 PM »

...For those without C3D...



This is really cool! And just a few lines :-) In VBA or .NET it takes much more code.
The conclusion is justified that the initialization of the development of critical subsystem optimizes the probability of success to the development of the technical behavior over a given period.

huiz

  • Swamp Rat
  • Posts: 870
  • Certified Prof C3D
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #31 on: November 23, 2010, 02:13:49 PM »
Piece of VBA code which will place Points at the insertion point of texts and taking the Z value of that text:

Code: [Select]
Public Sub ToolText2Point()
Dim acTekst As AcadText
Dim acPoint As AcadPoint
Dim pnt As Variant
 
Dim objTxt As AcadEntity
Dim objSelSet As AcadSelectionSet
Dim objSelCol As AcadSelectionSets
Dim strVal As String
Dim varData(3) As Variant
Dim intType(3) As Integer
     
  Set objSelCol = ThisDrawing.SelectionSets
 
  For Each objSelSet In objSelCol
    If objSelSet.Name = "HOOGTEPUNTEN" Then
      objSelCol.Item("HOOGTEPUNTEN").Delete
      Exit For
    End If
  Next
 
  ThisDrawing.Utility.Prompt vbCrLf & "This tool places Points above texts with a Z value of selected text." & vbCrLf
 
  Set objSelSet = objSelCol.Add("HOOGTEPUNTEN")
  intType(0) = -4
  varData(0) = "<OR"
  intType(1) = 0
  varData(1) = "TEXT"
  intType(2) = 0
  varData(2) = "MTEXT"
  intType(3) = -4
  varData(3) = "OR>"
  objSelSet.SelectOnScreen intType, varData
 
  For Each objTxt In objSelSet
    pnt = objTxt.InsertionPoint
   
    strVal = ReturnHoogteCijfer(objTxt.TextString)
    If IsNumeric(strVal) Then
     
      pnt(2) = CDbl(strVal)
     
      Set acPoint = ThisDrawing.ModelSpace.AddPoint(pnt)
    End If
   
  Next objTxt
 
  ThisDrawing.SelectionSets.Item("HOOGTEPUNTEN").Delete

End Sub



Function ReturnHoogteCijfer(varGetal As String) As String
Dim varGetalChecked As String

  varGetalChecked = Trim(varGetal)
 
  If Left(varGetalChecked, 1) = "+" Then
    varGetalChecked = Right(varGetalChecked, Len(varGetalChecked) - 1)
  End If

  varGetalChecked = Replace(varGetalChecked, ".", ",", 1, 1)
 
  ReturnHoogteCijfer = varGetalChecked
 
End Function

The conclusion is justified that the initialization of the development of critical subsystem optimizes the probability of success to the development of the technical behavior over a given period.

huiz

  • Swamp Rat
  • Posts: 870
  • Certified Prof C3D
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #32 on: November 23, 2010, 02:16:41 PM »
VB.Net solution with the same code to place Points, all in the zip file.
The conclusion is justified that the initialization of the development of critical subsystem optimizes the probability of success to the development of the technical behavior over a given period.

Robert98

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #33 on: November 24, 2010, 01:59:47 PM »
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)
)

Hi dear alanjt
Thanks for sharing your valuable codes , I worked with your codes in autocad 2010 , 2007 , 2004 and it action was same as each others and very good . in addition I executed it on many different types of topographic maps and results were perfectly correct. but at two types of my maps there are elevation strings and co responding survey point blocks . your routine put text string to z value of text insertion point but at real state the block points (surveying points ) must receive elevation string for replacing with z value of point's block coordinates . I want make two selection sets after your codes or in separate function so that the first one select all surveying point blocks and second select your 3d text in my map and at the next stage I want add z of your text to z 's block points (now all of them have zero value) but my problem is that there are many block points without elevation text near them , how I must filter them from those one have co responding text strings. :?
Robert   

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #34 on: November 24, 2010, 02:05:38 PM »
I must admit, I don't fully understand what you are wanting.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

mjfarrell

  • Seagull
  • Posts: 14444
  • Every Student their own Lesson
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #35 on: November 24, 2010, 02:40:59 PM »
I must admit, I don't fully understand what you are wanting.
better data from his surveyor to work with ; if you ask me   ;-)
Be your Best


Michael Farrell
http://primeservicesglobal.com/

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #36 on: November 24, 2010, 02:43:29 PM »
I must admit, I don't fully understand what you are wanting.
better data from his surveyor to work with ; if you ask me   ;-)
LoL
I've known crews like that.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Robert98

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #37 on: November 24, 2010, 03:14:00 PM »
I must admit, I don't fully understand what you are wanting.
Hi dear alanjt
I thank you for your quick reply
This is my sample position . you can see that elevation's strings lie above of survey points and point's number lie top of them (red text)  . the z value of all surveying points are zero and I want convert them to elevation's strings value and some points like P4 don't have any elevation's text . please tell me how I can remove points like P4 from selection sets . :oops:
thanks


Robert98

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #38 on: November 24, 2010, 03:21:43 PM »
I must admit, I don't fully understand what you are wanting.
better data from his surveyor to work with ; if you ask me   ;-)
Hi Higgs Boson's
this survey operation made more than 12 years ago and I don't Know surveyor man and at the other hand I haven't at this time any project like this , but it is a question for me and I want learn about this situation .

alanjt

  • Needs a day job
  • Posts: 5328
  • Standby for witty remark...
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #39 on: November 24, 2010, 03:25:53 PM »
I must admit, I don't fully understand what you are wanting.
Hi dear alanjt
I thank you for your quick reply
This is my sample position . you can see that elevation's strings lie above of survey points and point's number lie top of them (red text)  . the z value of all surveying points are zero and I want convert them to elevation's strings value and some points like P4 don't have any elevation's text . please tell me how I can remove points like P4 from selection sets . :oops:
thanks


post an example drawing.
Civil 3D 2019 ~ Windohz 7 64bit
Dropbox

Robert98

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #40 on: November 24, 2010, 04:36:29 PM »
I must admit, I don't fully understand what you are wanting.
Hi dear alanjt
I thank you for your quick reply
This is my sample position . you can see that elevation's strings lie above of survey points and point's number lie top of them (red text)  . the z value of all surveying points are zero and I want convert them to elevation's strings value and some points like P4 don't have any elevation's text . please tell me how I can remove points like P4 from selection sets . :oops:
thanks


post an example drawing.
Hi Alanjt
Here is my sample file that I purged all contour lines and other objects for convenience and to read better I deducted from the heights 2000 Unit

Robert98

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #41 on: November 26, 2010, 05:21:04 AM »

Hi dear members
I wrote this codes for elevating block points by value of text string but it return this error message :

; error: bad argument type:
lentityp nil
why ...?!  :oops:


Code: [Select]
(defun c:text2elev (/ tex     textnam   texent
      texlen     texhei   blk
      blknam     blkent   blkins
      blkref     delta_x   filter
      sst     sstn   sstent
      ssblk     ssblken   ssblkent
      blksiz     index   blklay
      blkname     texlay   find_box
      name_text     find_text_ins new_ins_point_blk
      ins_point_blk rigtexheit_point_1
      rigtexheit_point_2   left_point_1
      left_point_2
     )
  (setq tex (entsel "\n Please pick on ttexheie sample elevation text :")
textnam (car tex)
texent (entget textnam)
texlen (strlen (cdr (assoc 1 texent)))
texhei (cdr (assoc 40 texent))
texlay  (cdr (assoc 8 texent))
blk (entsel "\n Please pick on ttexheie sample survey block point :")
blknam (car blk)
blkent (entget blknam)
blkins (cdr (assoc 10 blkent))
blklay (cdr (assoc 8 blkent))
blkname (cdr (assoc 2 blkent))
delta_y
(+ (abs (- (cadr (cdr (assoc 10 texent)))
   (cadr (cdr (assoc 10 blkent)))
)
   )
   texhei
)
delta_x
(+ (abs (- (car (cdr (assoc 10 texent)))
   (car (cdr (assoc 10 blkent)))
)
   )
   (car (cadr(textbox texent)))
)

  );setq tex

  (setq filter (list
(cons 0 "insert")
(cons 8 blklay)
(cons 2 blkname)
       )
  )
  (setq ssblk  (ssget "x" filter)
blksiz (sslengttexhei ssblk)
index  0
  );setq ssblk
  (wtexheiile (< index blksiz)
    (setq blkref (ssname ssblk index))
    (setq ins_point_blk (cdr (assoc 10 (entget blkref)))
  left_point_1 (list (- (car ins_point_blk) 0.10)
       (- (cadr ins_point_blk) 0.10)
       0
)
  left_point_2 (list (- (car ins_point_blk) 0.10)
       (+ (cadr ins_point_blk) delta_y 0.10)
       0
)
  rigtexheit_point_1 (list (+ (car ins_point_blk) delta_x 0.10)
       (- (cadr ins_point_blk) 0.10)
       0
)
rigtexheit_point_2 (list (+ (car ins_point_blk) delta_x 0.10)
       (+ (cadr ins_point_blk) delta_y 0.10)
       0
)
  pt (list left_point_1 left_point_2 rigtexheit_point_2 rigtexheit_point_1  left_point_1)
   );setq ins_point_blk
    (if (and
  (setq find_box (ssget "WP"
pt
(list (cons 0 "text")
      (cons 8 texlay)
      (cons 40 texhei)
)


)

  );setq "W"




);and


      (progn
(if (= 1 (sslengttexhei find_box))
  (progn
    (setq name_text (ssname find_box index))
    (setq find_text_ins (cdr (assoc 10 (entget name_text))))
    (setq new_ins_point_blk
   (list (car ins_point_blk)
(cadr ins_point_blk)
(atof
   (cdr
     (assoc
       1
       (entget name_text)
     )
   )
)
   )
    );setq new_ins_point_blk
    (setq ins_point_blk new_ins_point_blk)
   
  );progn
);end if

      ) ;progn
    );end if
    (setq index (1+ index))
  );end wtexheiile
  (command "regen all")
  (command "zoom" "e")
  (princ ins_point_blk)
  (princ new_ins_point_blk)
  (princ)

);defun



roy_043

  • Water Moccasin
  • Posts: 1799
  • BricsCAD 18
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #42 on: November 26, 2010, 07:26:10 AM »
6 problems. 3 due to replacing "h" with "texhei" :roll:.

Code: [Select]
(defun c:text2elev (/ tex     textnam   texent
      texlen     texhei   blk
      blknam     blkent   blkins
      blkref     delta_x   filter
      sst     sstn   sstent
      ssblk     ssblken   ssblkent
      blksiz     index   blklay
      blkname     texlay   find_box
      name_text     find_text_ins new_ins_point_blk
      ins_point_blk rigtexheit_point_1
      rigtexheit_point_2   left_point_1
      left_point_2
     )
  (setq tex (entsel "\n Please pick on ttexheie sample elevation text :")
textnam (car tex)
texent (entget textnam)
texlen (strlen (cdr (assoc 1 texent)))
texhei (cdr (assoc 40 texent))
texlay  (cdr (assoc 8 texent))
blk (entsel "\n Please pick on ttexheie sample survey block point :")
blknam (car blk)
blkent (entget blknam)
blkins (cdr (assoc 10 blkent))
blklay (cdr (assoc 8 blkent))
blkname (cdr (assoc 2 blkent))
delta_y
(+ (abs (- (cadr (cdr (assoc 10 texent)))
   (cadr (cdr (assoc 10 blkent)))
)
   )
   texhei
)
delta_x
(+ (abs (- (car (cdr (assoc 10 texent)))
   (car (cdr (assoc 10 blkent)))
)
   )
   (car (cadr(textbox texent)))
)

  );setq tex

  (setq filter (list
(cons 0 "insert")
(cons 8 blklay)
(cons 2 blkname)
       )
  )
  (setq ssblk  (ssget "x" filter)
[color=red] blksiz (sslength ssblk) ;; changed[/color]
index  0
  );setq ssblk
[color=red]  (while (< index blksiz) ;; changed[/color]
    (setq blkref (ssname ssblk index))
    (setq ins_point_blk (cdr (assoc 10 (entget blkref)))
  left_point_1 (list (- (car ins_point_blk) 0.10)
       (- (cadr ins_point_blk) 0.10)
       0
)
  left_point_2 (list (- (car ins_point_blk) 0.10)
       (+ (cadr ins_point_blk) delta_y 0.10)
       0
)
  rigtexheit_point_1 (list (+ (car ins_point_blk) delta_x 0.10)
       (- (cadr ins_point_blk) 0.10)
       0
)
rigtexheit_point_2 (list (+ (car ins_point_blk) delta_x 0.10)
       (+ (cadr ins_point_blk) delta_y 0.10)
       0
)
  pt (list left_point_1 left_point_2 rigtexheit_point_2 rigtexheit_point_1  left_point_1)
   );setq ins_point_blk
    (if (and
  (setq find_box (ssget "WP"
pt
(list (cons 0 "text")
      (cons 8 texlay)
      (cons 40 texhei)
)


)

  );setq "W"




);and


      (progn
[color=red] (if (= 1 (sslength find_box)) ;; changed[/color]
  (progn
[color=red]     (setq name_text (ssname find_box 0)) ; changed[/color]
    (setq find_text_ins (cdr (assoc 10 (entget name_text))))
    (setq new_ins_point_blk
   (list (car ins_point_blk)
(cadr ins_point_blk)
(atof
   (cdr
     (assoc
       1
       (entget name_text)
     )
   )
)
   )
    );setq new_ins_point_blk
[color=red]     (entmod (subst (cons 10 new_ins_point_blk) (cons 10 ins_point_blk) (entget blkref))) ;; changed[/color]
   
  );progn
);end if

      ) ;progn
    );end if
    (setq index (1+ index))
  );end wtexheiile
[color=red]  (command "regen") ; changed[/color]
  (command "zoom" "e")
  (princ ins_point_blk)
  (princ new_ins_point_blk)
  (princ)

);defun

Robert98

  • Guest
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #43 on: November 26, 2010, 10:00:10 AM »
6 problems. 3 due to replacing "h" with "texhei" :roll:.

Code: [Select]
(defun c:text2elev (/ tex    textnam  texent
     texlen    texhei  blk
     blknam    blkent  blkins
     blkref    delta_x  filter
     sst    sstn  sstent
     ssblk    ssblken  ssblkent
     blksiz    index  blklay
     blkname    texlay  find_box
     name_text    find_text_ins new_ins_point_blk
     ins_point_blk rigtexheit_point_1
     rigtexheit_point_2  left_point_1
     left_point_2
    )
  (setq tex (entsel "\n Please pick on ttexheie sample elevation text :")
textnam (car tex)
texent (entget textnam)
texlen (strlen (cdr (assoc 1 texent)))
texhei (cdr (assoc 40 texent))
texlay  (cdr (assoc 8 texent))
blk (entsel "\n Please pick on ttexheie sample survey block point :")
blknam (car blk)
blkent (entget blknam)
blkins (cdr (assoc 10 blkent))
blklay (cdr (assoc 8 blkent))
blkname (cdr (assoc 2 blkent))
delta_y
(+ (abs (- (cadr (cdr (assoc 10 texent)))
  (cadr (cdr (assoc 10 blkent)))
)
  )
  texhei
)
delta_x
(+ (abs (- (car (cdr (assoc 10 texent)))
  (car (cdr (assoc 10 blkent)))
)
  )
  (car (cadr(textbox texent)))
)

  );setq tex

  (setq filter (list
(cons 0 "insert")
(cons 8 blklay)
(cons 2 blkname)
      )
  )
  (setq ssblk  (ssget "x" filter)
[color=red] blksiz (sslength ssblk) ;; changed[/color]
index  0
  );setq ssblk
[color=red]  (while (< index blksiz) ;; changed[/color]
    (setq blkref (ssname ssblk index))
    (setq ins_point_blk (cdr (assoc 10 (entget blkref)))
 left_point_1 (list (- (car ins_point_blk) 0.10)
      (- (cadr ins_point_blk) 0.10)
      0
)
 left_point_2 (list (- (car ins_point_blk) 0.10)
      (+ (cadr ins_point_blk) delta_y 0.10)
      0
)
 rigtexheit_point_1 (list (+ (car ins_point_blk) delta_x 0.10)
      (- (cadr ins_point_blk) 0.10)
      0
)
rigtexheit_point_2 (list (+ (car ins_point_blk) delta_x 0.10)
      (+ (cadr ins_point_blk) delta_y 0.10)
      0
)
 pt (list left_point_1 left_point_2 rigtexheit_point_2 rigtexheit_point_1  left_point_1)
  );setq ins_point_blk
    (if (and
 (setq find_box (ssget "WP"
pt
(list (cons 0 "text")
     (cons 8 texlay)
     (cons 40 texhei)
)


)

 );setq "W"




);and


      (progn
[color=red] (if (= 1 (sslength find_box)) ;; changed[/color]
 (progn
[color=red]    (setq name_text (ssname find_box 0)) ; changed[/color]
   (setq find_text_ins (cdr (assoc 10 (entget name_text))))
   (setq new_ins_point_blk
  (list (car ins_point_blk)
(cadr ins_point_blk)
(atof
  (cdr
    (assoc
      1
      (entget name_text)
    )
  )
)
  )
   );setq new_ins_point_blk
[color=red]    (entmod (subst (cons 10 new_ins_point_blk) (cons 10 ins_point_blk) (entget blkref))) ;; changed[/color]
 
 );progn
);end if

      ) ;progn
    );end if
    (setq index (1+ index))
  );end wtexheiile
[color=red]  (command "regen") ; changed[/color]
  (command "zoom" "e")
  (princ ins_point_blk)
  (princ new_ins_point_blk)
  (princ)

);defun
Hi Roy
First I must thank you to reply and good hints
I changed my codes to your red line format and run it on a sample file that had 8 elements (like attached image) without any error messages but when I checked block points by id command the z value of blocks : P1,P6,P7,P8 stay at old value (zero) and other ones changed to corresponding text string values , it means that correctly half of them changed and elevated and others not elevated , please tell me why this occurs ?
Robert
« Last Edit: November 26, 2010, 10:40:57 AM by Robert98 »

Pad

  • Bull Frog
  • Posts: 315
Re: Elevating Flat Polylines to Close Numeric Text Value
« Reply #44 on: November 26, 2010, 10:48:37 AM »
this vlx from xanadu will do what you want

http://www.xanadu.cz/dl_file.asp?ID=583

p