help with extracting text from one dimension....

[leonucadomi]

hello :

 

I had a routine that did this but I lost it  

 

1.- I need to select a dimension

2.- then a text will be created with the style and size of the selected dimension

3.- that text will move from the center point to where the user determines

 

like exploding the dimension and moving the text to another place but not exploding it

 

 

 

 

 

test.dwg

[marko_ribar]

Not sure, have you tried NCOPY command?

[leonucadomi]

ncopy is similar to what I need but it's only for blocks

[mhupp]

This is the quick and dirty version. no error handling.

 

• Copies the whole dimension to the new location.
• Explodes the copied dimension
• Erases everything but the MTEXT
• Explodes Mtext into text don't know if it keeps its style? seems to.

 

;;----------------------------------------------------------------------------;;
;; Copy dimension value to another location
(defun C:DimCopy (/ dim BP LastEnt  en)
  (vl-load-com)
  (while (setq dim (car (entsel "\nSelect Dimension: ")))
    (setq dim (vlax-ename->vla-object dim))
    (setq BP (vlax-get dim 'TextPosition))
    (setq LastEnt (entlast))
    (setq copy (vla-copy dim))
    (vla-move copy BP (getpoint BP "\nCopy locaiton"))
    (command "_Explode" (entlast))
    (if (setq en (entnext LastEnt))
      (while en
        (cond
          ((= "MTEXT" (cdr (assoc 0 (entget en))))
            (command "_Explode" en) ;convert mtext to text
          )
          ((= "TEXT" (cdr (assoc 0 (entget en))))
            (progn)
          )
          (t
            (entdel en)
          )          
        )
        (setq en (entnext en))
      )
    )      
  )
  (princ)
)

 

Edited July 12, 2022 by mhupp

[Steven P]

-EDIT- I was going at this the other way to Mhupp, get the information from the dimension and them make new text, many ways to do the same thing-

 

You can get the text itself if you use

 

(setq MyDim (entget (car (entsel "Select Dimension"))))

 

which gives an associated list of the dimension entity stuff.

 

In this list number 1 gives Text Override value and 42 gives the measured value

 

(setq TextOverride (cdr (assoc 1 MyDim)))
(setq MyDimValue (cdr (assoc 42 MyDim)))

 

you might have to decide if you need to use text override values or just the measured dimension, and note here that if the text override text contains <> this means it will show the measured dimension there... so will need to take into account that as well. I think there is a chance that in a very very long text override code 304 will take any overspill from code 1.. but I'd be surprised if you need to consider that (also 172 and 4 but I can't remember why I made a note of them)

 

 

So onto the text styles, these are not saved in the dimension but in the dimension style and I think you have to do a little more work to get them

 

(setq DimStyleName (cdr (assoc 3 MyDim)))

 

will give you the dim style name and you can do a table search to get the dim style definition:

 

(setq DimstyleDefinition (tblsearch "DIMSTYLE" DimStyleName))

 

 

However I will have to come back to this to get the next part for you - should be sometihng there for you to think about and start you off making something up, at least getting the text to start with

 

 

--EDIT--

This will give you the text style name, though this is for the dimension style used and not any over ride the user might change to

 

(setq DimTxtEntity (entget (cdr (assoc 340 DimstyleDefinition))) )
(setq DimTxtStyle (cdr (assoc 2 DimTxtEntity)))

 

Edited July 13, 2022 by Steven P

[mhupp]

Yeah started to go that way but when I looked at dimension dxf codes it seemed simpler just to copy and explode.

[Steven P]

I'm changing my mind, might go dxf code to get the text, create text and match properties as an alternative method

[marko_ribar]

Hmm...

Not sure, but could you confirm that you can't recomposite DIMENSION entity to static BLOCK and just use NCOPY...

[Steven P]

2 minutes ago, marko_ribar said:

Hmm...

Not sure, but could you confirm that you can't recomposite DIMENSION entity to static BLOCK and just use NCOPY...

 

I would guess... just a guess of course... that if you do that then you loose the dimension functionality - move a line, stretch or whatever and the dimension 'value' won't update with it?

[marko_ribar]

Well, then after NCOPY, just do copyclip, UNDO to DIMENSION and pasteclip...

[leonucadomi]

dear mhupp:

 

something is wrong and it doesn't work...  

 

 

 

 

 

 

 

[mhupp]

36 minutes ago, leonucadomi said:

 

 

 

This is errors before you select a copy to location? Remove BP from getpoint should fix it.

(vla-move copy BP (getpoint BP "\nCopy locaiton"))
to
(vla-move copy BP (getpoint "\nCopy locaiton"))

 

its used to draw a dashed line from the dim you picked like so, but isn't necessary.

 

 

 

[Steven P]

Try this one, a different way to MHUPP and just for fun

 

Notes:

The font and height used will be as defined in the dimension style and not to any overridden style for that particular dimension entity - I couldn't work out how to do that bit.

There is no error checking or checking that you select a dimension, though that is all online

If I was taking this further I would round the text point coordinates to the nearest 1.25 units, just because (in case snaps and grid and so are turned off)

Need to localise the variables too

 

 

but try this and see if it mostly works

 

 

(defun c:GetDimTxt ( / )
  (defun createtext ( MyText TextPoint font textheight / )
      (entmake (list
      '(0 . "TEXT")
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(100 . "AcDbText")
      (cons 10 TextPoint)
      (cons 40 textheight)
      (cons 1 MyText)
      '(50 . 0.0)
      '(41 . 1.0)
      '(51 . 0.0)
      (cons 7 font)
      '(71 . 0)
      '(72 . 0)
      '(11 0.0 0.0 0.0)
      '(210 0.0 0.0 1.0)
      '(100 . "AcDbText")
      '(73 . 0)
    ));end list, entmake
  )
  (defun FindReplace: (Str$ Find$ Replace$ / Cnt# FindLen# Loop Mid$ NewStr$ ReplaceLen#)
    (setq Loop t Cnt# 1 NewStr$ Str$ FindLen# (strlen Find$) ReplaceLen# (strlen Replace$))
    (while Loop
      (setq Mid$ (substr NewStr$ Cnt# FindLen#))
      (if (= Mid$ Find$)
        (setq NewStr$ (strcat (substr NewStr$ 1 (1- Cnt#)) Replace$ (substr NewStr$ (+ Cnt# FindLen#)))
              Cnt# (+ Cnt# ReplaceLen#)
        );setq
        (setq Cnt# (1+ Cnt#))
      );if
      (if (= Mid$ "") (setq Loop nil))
    );while
    NewStr$
  );defun FindReplace:

  (defun radtodeg( rad / ) (/ (* rad 180.0) pi) )

;;Get Dimensions Stuff
  (setq MyDim (entget (car (entsel "Select Dimension"))))
  (setq DimStyleName (cdr (assoc 3 MyDim)))
  (setq DimstyleDefinition (tblsearch "DIMSTYLE" DimStyleName))
  (setq DimTxtEntity (entget (cdr (assoc 340 DimstyleDefinition))) )
  (setq DimType (cdr (assoc 100 (reverse MyDim))) )
  (setq DimTxtPos (cdr (assoc 11 MyDim)) )
  (setq TextOverride (cdr (assoc 1 MyDim)))
  (setq MyDimValue (cdr (assoc 42 MyDim)))
  (setq DimTxtHeight (cdr (assoc 140 DimstyleDefinition)))
  (setq DimTxtStyle (cdr (assoc 2 DimTxtEntity)))

(setq dimensiontypes (list "AcDbAlignedDimension" "AcDbRotatedDimension" "AcDbOrdinateDimension" "AcDsbAngularDimension"
                           "AcsDb2LineAngularDimension" "AcDb3PointAngularDimension" "AscDbDiametricDimension"
                           "AcDbRadialDimension" "AcDbRadialDimensionLarge" "AcDbArcDimension"
))
  (if (= DimType "AcDb2LineAngularDimension")(setq MyDimValue (radtodeg MyDimValue)))

;;Check text to use
  (if (= TextOverride "")
    (setq MyText (rtos MyDimValue))
    (setq MyText (FindReplace: TextOverride "<>" (rtos MyDimValue)))
  )

  (setq TextPoint (getpoint DimTxtPos "Select Text Point"))
  (createtext MyText TextPoint DimTxtStyle DimTxtHeight)
)

 

 

 

Edited July 13, 2022 by Steven P
Fixed for Angular Dimensions

[leonucadomi]

 

I MODIFIED AND IT STILL DOESN'T WORK FRIEND   

 

 

 

 

 

 

 

[mhupp]

can you upload a sample drawing with one dim so i can test?

[Steven P]

Likewise I am getting an error - is it a BricsCAD / AutoCAD thing maybe with the line 

    (vla-move copy BP (getpoint "\nCopy locaiton"))

which is where it stops and comes up with the error

"Copy locaiton; error: lisp value has no coercion to VARIANT with this type:"

 

I haven't looked to see why it is doing that though

 

 

[leonucadomi]

SURE

test.dwg

[mhupp]

no idea why its working for me and not you guys. took out the vla-copy and just use command

--edit

@leonucadomi you try Steven's lisp?

 

;;----------------------------------------------------------------------------;;
;; Copy dimension value to another location
(defun C:DimCopy (/ dim BP LastEnt  en)
  (vl-load-com)
  (setvar 'cmdecho 0)
  (while (setq dim (car (entsel "\nSelect Dimension: ")))
    (setq obj (vlax-ename->vla-object dim))
    (setq BP (vlax-get obj 'TextPosition))
    (setq LastEnt (entlast))
    (command "_.Copy" dim "" "_non" BP (getpoint BP "\nCopy to: "))
    (command "_Explode" (entlast))
    (if (setq en (entnext LastEnt))
      (while en
        (cond
          ((= "MTEXT" (cdr (assoc 0 (entget en))))
            (command "_Explode" en) ;convert mtext to text
          )
          ((= "TEXT" (cdr (assoc 0 (entget en))))
            (progn)
          )
          (t
            (entdel en)
          )          
        )
        (setq en (entnext en))
      )
    )      
  )
  (setvar 'cmdecho 1)
  (princ)
)

 

Edited July 13, 2022 by mhupp

[leonucadomi]

THIS IS EXACTLY WHAT I NEEDED THANK YOU

 

THANKS GUYS

[ronjonp]

Here's another way to do it but the end result is MTEXT and you have to pick the text.

(defun c:foo (/ e el p1 p2)
  (if (and (setq e (car (nentsel "\nPick dimension text: ")))
	   (setq p1 (cdr (assoc 10 (setq el (entget e)))))
	   (setq p2 (getpoint p1 "\nSpecify second point: "))
      )
    (entmakex (append (vl-remove-if '(lambda (x) (= 330 (car x))) el) (list (cons 10 p2))))
  )
  (princ)
)