leonucadomi Posted July 12, 2022 Posted July 12, 2022 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 Quote
marko_ribar Posted July 12, 2022 Posted July 12, 2022 Not sure, have you tried NCOPY command? 1 Quote
leonucadomi Posted July 12, 2022 Author Posted July 12, 2022 ncopy is similar to what I need but it's only for blocks Quote
mhupp Posted July 12, 2022 Posted July 12, 2022 (edited) 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 2 Quote
Steven P Posted July 12, 2022 Posted July 12, 2022 (edited) -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 1 Quote
mhupp Posted July 12, 2022 Posted July 12, 2022 Yeah started to go that way but when I looked at dimension dxf codes it seemed simpler just to copy and explode. Quote
Steven P Posted July 13, 2022 Posted July 13, 2022 I'm changing my mind, might go dxf code to get the text, create text and match properties as an alternative method Quote
marko_ribar Posted July 13, 2022 Posted July 13, 2022 Hmm... Not sure, but could you confirm that you can't recomposite DIMENSION entity to static BLOCK and just use NCOPY... Quote
Steven P Posted July 13, 2022 Posted July 13, 2022 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? Quote
marko_ribar Posted July 13, 2022 Posted July 13, 2022 Well, then after NCOPY, just do copyclip, UNDO to DIMENSION and pasteclip... Quote
leonucadomi Posted July 13, 2022 Author Posted July 13, 2022 dear mhupp: something is wrong and it doesn't work... Quote
mhupp Posted July 13, 2022 Posted July 13, 2022 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. 1 Quote
Steven P Posted July 13, 2022 Posted July 13, 2022 (edited) 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 2 Quote
leonucadomi Posted July 13, 2022 Author Posted July 13, 2022 I MODIFIED AND IT STILL DOESN'T WORK FRIEND Quote
mhupp Posted July 13, 2022 Posted July 13, 2022 can you upload a sample drawing with one dim so i can test? Quote
Steven P Posted July 13, 2022 Posted July 13, 2022 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 Quote
mhupp Posted July 13, 2022 Posted July 13, 2022 (edited) 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 1 Quote
leonucadomi Posted July 13, 2022 Author Posted July 13, 2022 THIS IS EXACTLY WHAT I NEEDED THANK YOU THANKS GUYS Quote
ronjonp Posted July 13, 2022 Posted July 13, 2022 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) ) 3 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.