convert text to attribute in a block

[OMEGA-ThundeR]

Hi,

 

i have a drawing, a highway. It has milemarkers in a sourcefile, but they are 'text' elements.  The content goes like this '100.1 - 100.2 -  100.3 etc'

Since i need this 'textbased milemarker' to be a nice block i want to convert those text element to a block. With attribute text that contains the value of the text.
Since there are hundreds of those milemarkers it must be 1 block (so the same blockname) per milemarker.

So not  'block100.1 - block100.2 - block100.3 etc'.  But just a single block per milemarker, that if i change the look of 1, they all change.

Would this be possible to do with a lisp?

Converting to an attribute text wouldn't be so hard, but to convert those to a block with the same name (but different content) is. Or at least i can't find a lisp or something that does this.
Any help would be appreciated.

[Steven P]

Are they all evenly placed along the highway? I think Lee Mac had a chainage LISP somewhere they had a block at each point (1 mile or whatever) and annotated this with the distance - change the block layout to suit your needs maybe

 

Anyway, perhaps a chainage LISP might be what you need? I'll try to remember to look for one for you

[CyberAngel]

Seems like it would be easier to create the blocks and their attributes from the source and bypass the text entirely. Do you have coordinates for each block or is it just stations along a road?

 

I assume you don't have Civil 3D because this is a simple matter with alignment labels, you just have to define the style correctly. You don't even need the attributes because you can build a table from the labels.

[BIGAL]

Like Steven P google "Chainage.lsp Autocad lisp", most will give a text label oriented to the alignment line. To change to a block with attribute is like replace 1 line.

 

Post a dwg and answer the questions about just enter spacing and chainages get made.

[OMEGA-ThundeR]

The 'milemarkers' are 'evenly' spaced, but it not a new design.  But it could be 1.001 miles between or 0.9978. You get the idea.

The location of the markers is know. Its the basepoint of the text object. There is an extra block holding that spot for 'icon' purposes, but the text is not linked to that block.  It never was, it's how the sourcefile was supplied (a download service from the official source, so what you see is what you get).

i could try to create something 'complex' like 'connecting the dots'.  Create a polyline over the basepoints of the text, place a new block with a attribute text and make it so that starting from the beginning it needs to place a block on every vertext and adding a .1 increment on a starting value.

Scripting something like that would probably take me a day :P,  That would take as much time as doing it all manually, but then i atleast know it would be 100% good.

Anything that would decrese that manual labor would be nice.

 

[Steven P]

Are all the marker texts on their own layer, so you could isolate them from other texts (turn off everything else with text in leaving just the text you want?)

 

This is one I use and can be modified - however it is taken from a larger LISP file, something might be missing so let me know if it doesn't work.

 

It asks "select text" - here select the distances, 1 mile, 1.01 mile, whatever, this has to be just a number in the drawing "1.11" and not say "1.11m". Then select profile is the polyline route on which to put the markers, and finally start end (0 distance) - start end has to be the end of the polyline, can't be part way along it. The chainage marker is a block made in the routine and can be amended.

 

I think if you just want evenly spaced markers the link at the top of the code does that (1, 2, 3 miles etc) - again with a marker block that can be modified.

 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;https://www.cadtutor.net/forum/topic/1264-drawing-points-along-polyline/
(defun C:LSChainage ( / MyPt ppt pent ang cumm_dist dis dist_list leng obj pt reversed)
;; Set Attribute Value  -  Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [ent] Block (Insert) Entity Name
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
  (defun LM:setattributevalue ( blk tag val / enx )
      (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
          (if (= (strcase tag) (strcase (cdr (assoc 2 enx))))
              (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx))
                  (progn
                      (entupd blk)
                      val
                  ) ; end progn
              ) ; end if
              (LM:setattributevalue blk tag val)
          ) ; end if
      ) ; end if
  ) ; end defun
;;Chainage, make a small mark every 1/2 distance and add distance and big mark every distance
  (defun make_blk_measure ( / )
    (if (not (tblsearch "STYLE" "$BLK_MEAS"))
      (entmake '((0 . "STYLE")
                (5 . "40")
                (100 . "AcDbSymbolTableRecord")
                (100 . "AcDbTextStyleTableRecord")
                (2 . "$BLK_MEAS")
                (70 . 0)
                (40 . 0.0)
                (41 . 0.7)
                (50 . 0.0)
                (71 . 0)
                (42 . 0.1)
                (3 . "ARIAL.TTF")
                (4 . "")
        ) ; end '( list
      ) ; end entmake
    ) ; end if
    (if (not (tblsearch "BLOCK" "BLK_MEASURE_CURVE"))
      (progn
        (entmake
    '((0 . "BLOCK") (8 . "0") (2 . "BLK_MEASURE_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0))
        ) ; end entmake
        (entmake
          (append
      '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine"))
      (list (list 10 0.0 (- (getvar "TEXTSIZE")) 0.0))
      (list (list 11 0.0 (getvar "TEXTSIZE") 0.0))
      '((210 0.0 0.0 1.0))
          ) ; end eppend
        ) ; end entmake
        (entmake
          '(
            (0 . "ATTDEF")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (62 . 0)
            (6 . "ByBlock")
            (370 . -2)
            (100 . "AcDbText")
            (10 0.0 0.0 0.0)
            (40 . 2.5) ; font height
            (1 . "0.0")
            (50 . 1.570796326794896)
            (41 . 0.7)
            (51 . 0.0)
;;            (7 . "$BLK_MEAS")
            (71 . 8)
            (72 . 1)
            (11 1.0 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttributeDefinition")
            (3 . "measure")
            (2 . "VALUE_MEASURE")
            (70 . 0)
            (73 . 0)
            (74 . 1)
          ) ; end '( list
        ) ; end entmake
        (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2)))
      ) ; end prgn
    ) ; end if

    (if (not (tblsearch "BLOCK" "BLK_TICK_CURVE"))
      (progn
        (entmake
    '((0 . "BLOCK") (8 . "0") (2 . "BLK_TICK_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0))
        ) ; end entmake
        (entmake
          (append
      '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine"))
      (list (list 10 0.0 (* 0.5 (- (getvar "TEXTSIZE"))) 0.0))
      (list (list 11 0.0 (* 0.5 (getvar "TEXTSIZE")) 0.0))
      '((210 0.0 0.0 1.0))
          ) ; end append
        ) ; end entmake
        (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2)))
      ) ; end progn
    ) ; end if
  ) ; end defun 'make_blk_measure'


;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/end-selection-in-loop-with-enter-button/td-p/8815294
  (defun LSGrabTexts ( / distlist ent)
    (setq distlist nil)
    (setvar 'errno 0)
    (while ; loop selecting texts
      (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Text: ")))
        (cond
          (   (= 7 (getvar 'errno)) ;cond a
            (princ "\nMissed, try again.")
          ) ;end cond a
          (   (= 'ename (type ent)) ;cond b
            (princ (setq dist (cdr (assoc 1 (entget ent)))) )
            (setq distlist (append distlist (list (atof dist))))
          ) ;end cond b
        ) ; end progn
      ) ; end while
    ) ; end defun
    (princ "\nDistances: ")(princ distlist)
    distlist
  )

  ;;End sub functions;;

  (setq dist_list (LSGrabTexts)) ; get absolute distances
  (setq dist_list_orig dist_list)
  (setq cumm_dist (apply 'max dist_list))
  (setq dis 0.0)
  (setq pent (car (entsel "\n >> Select profile >>")))
  (setq ppta (assoc 10 (entget pent))) ; start of route line
  (setq pptb (assoc 10 (reverse (entget pent)) )) ; end of route line
  (setq MyPt (getpoint "\nSelect Start Point"))
  (setq obj (vlax-ename->vla-object pent))
  (setq leng (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj)))

  (if (or ;; Selected MyPt at ends of route line
      (= (vlax-curve-getdistatpoint obj MyPt) 0)
      (= (vlax-curve-getdistatpoint obj MyPt) leng)
    )
    (progn
    ) ; end progn
    (progn
      (setq MyEndPt (getpoint "\nSelect a Point in the Direction"))
      (setq lenga (vlax-curve-getdistatpoint obj MyPt))
      (setq lengb (vlax-curve-getdistatpoint obj MyEndPt))
      (if (< lenga lengb)
        (progn
          (princ "\nA-B Calc Start Point")
          (setq newlist (list))
          (setq acount 0)
          (while (< acount (length dist_list))
            (setq newval (+ lenga (nth acount dist_list)))
            (if (< newval 0)(setq newval 0))
            (setq newlist (append newlist (list newval)))
            (setq acount (+ acount 1))
          )
          (setq dist_list newlist)
          (setq MyPt (list (cadr ppta) (caddr ppta) 0) )
        ) ; end progn
        (progn
          (princ "\nB-A Calc Start Point")
          (setq newlist (list))
          (setq acount 0)
          (while (< acount (length dist_list))
            (setq newval (+ (- leng lenga) (nth acount dist_list)))
            (if (< newval 0)(setq newval 0))
            (setq newlist (append newlist (list newval)))
            (setq acount (+ acount 1))
          )
          (setq dist_list newlist)
          (setq MyPt (list (cadr pptb) (caddr pptb) 0) )
        ) ; end progn
      ) ; end if
    ) ; end progn
  ) ; end if


  (if (= (vlax-curve-getdistatpoint obj MyPt) 0)
    ()
    (progn
      (princ "\nReverse")
      (setq newlist (list))
      (setq acount 0)
      (while (< acount (length dist_list))
        (setq newval (- leng (nth acount dist_list)))
        (if (< newval 0)(setq newval 0))
        (setq newlist (append newlist (list newval)))
        (setq acount (+ acount 1))
      )
      (princ newlist)
      (setq dist_list newlist)
    )
  ) ; end if

  (setq acount 0)
  (while (< acount (length dist_list))
    (setq dis (nth acount dist_list))
    (if (> (nth acount dist_list) leng)(setq dis leng)) ;; fudge if SOP greater than route length??
    (setq pt (vlax-curve-getpointatdist obj dis))
;;insert block 'tick'
    (make_blk_measure)
    (setq ang (angle '(0 0 0) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pt))))
    (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'InsertBlock pt "BLK_MEASURE_CURVE" 1 1 1 ang)
    (setq MyLastBlock (entlast))

    (LM:setattributevalue MyLastBlock "VALUE_MEASURE" (strcat (rtos (nth acount dist_list_orig))) )


;;or draw point:
;;      (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'AddPoint pt) (setq dist_list (cdr dist_list))
    (setq acount (+ acount 1))
  ) ;end while

  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

[OMEGA-ThundeR]

@Steven P

Hmm. i guess it does most of what i want, however it needs a 'profile' and places the blocks on that. So i guess the lisp is complete, i didn't see any errors.

What it does i like:

- Change text value to a block, and when multiple textobjects are selected they each get an individual block with there own content.  The blockname is the same, so editing one will edit them all.

I could try to edit it for the following functions i need; (if i can, but limited on time right now, the project where i need this lisp for has no haste for the coming month)

- Select multiple text objects at once. it might be that the order of selection is needed for the original lisp intention, but has no use for my case.
- Place the block on the insertion point of the original text object, not on a profile or any other location.
- Precision of 3 decimals is not needed, just copy value of text without edits.  But that could be the reason why 'only number values' wil be read from supplied lisp.
- The text  (my milemarkers) can contain a suffix in the form of a letter, so in light of previous point -> just copy the value, not an number/integer.


 

Edited December 18, 2023 by OMEGA-ThundeR