Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

lisp to create a dimension from broken dimension

23 REPLIES 23
SOLVED
Reply
Message 1 of 24
Anonymous
4786 Views, 23 Replies

lisp to create a dimension from broken dimension

I have some drawings where the dimensions have been exploded and i am trying to build a lisp where i can rebuild them.  What is would like to be able to do is pick all the exploded lines and arrows to be removed.  Then pick the text to be removed.  Then pick the new extension line origins, then place the final location for my new dimension (dimalign) and have the text replace with the dimension replaced with the text i erased from the old exploded dimension.  Can anyone help me modify what I have below to make this work?   thx

 

(defun c:D11 (/ lead)

(command "_.LAYER" "_new" "DIM" "")

(command "_.layer" "_color" "6" "DIM" "")

(setvar "clayer" "dim")

(command "dimstyle" "r" "AA DIM I")

(setvar 'osmode 759)

(setq lead (ssget))

(command "__dimlinear" "\\" "\\" "\\")

(command "erase" lead "")

  (princ)

)

23 REPLIES 23
Message 2 of 24
Moshe-A
in reply to: Anonymous

@Anonymous hi,

 

instead of selecting each line in order to identify the extents of the dimension line it's more nature to specify 3 points as dimlinear command works.

 

so here is my version

it starts by requesting the user to pick  1st point + 2nd point + 3rd point which is the dimension line location but you must pick the 3rd point at the opposite direction of the 1st point.

 

in dxf terms:

the  1st point is dxf code 13

the 2nd point is dxf code 14

the 3rd point is dxf code 10 and it's is the intersection point from 2nd point perpendicular to dimension line.

 

after you pick these 3 points an (ssget) is invoked by "fence" selection-method to trace the dimension line from 1st point to 4th point (is dxf code 12 and it's the intersection point from 1st point perpendicular to the dimension line) to 3rd point to 2nd point selection all objects it crosses (lines, mtext, solids\arrow blocks) but it depend how the dimension style was defined? and what arrow blocks are used. an ssget filter is applied there you can add a layers name to the filter if you positive about the exploded lines lay on that layer (do you know how?)

 

than the selection is deleted and the new dimension is drawn then sent to the target layer.

 

Note the use of LAYER_NAME and DIMSTYLE_NAME as constants. you can specify any other layer or dimstyle if you like (save you time to change them in other places in code)

 

if the target  DIMSTYLE_NAME is not exist? it will be created from the current dimstyle. define your own dimstyle before running this lisp.

 

limitation: work only with orthogonal dimensions.

 

enjoy

moshe

 

 

; Recover eXploded Dimension
(defun c:RXD (/ make_layer make_dimstyle ; local functions
	        LAYER_NAME DIMSTYLE_NAME savOSmode p13 p14 p10 p12 p15 ss ;| local variables |;)

 (defun make_layer (/ tbl)
  (if (null (setq tbl (tblsearch "layer" LAYER_NAME))) ; is layer exist?
   (command "_.layer" "_new" LAYER_NAME "_color" 6 LAYER_NAME "" "")
   ; else
   (if (/= (cdr (assoc '62 tbl)) 6) ; set LAYER_NAME color 6 only if it has something else
    (command "_.layer" "_color" 6 LAYER_NAME "")
   )
  ); if
 ); make_layer

 (defun make_dimstyle ()
  (if (null (tblsearch "dimstyle" DIMSTYLE_NAME)) ; is dimstyle exist?
   (command "._dimstyle" "_save" DIMSTYLE_NAME)
   ; else 
   (if (/= (strcase (getvar "dimstyle")) DIMSTYLE_NAME)
    (command "_.dimstyle" "_restore" DIMSTYLE_NAME) ; set DIMSTYLE_NAME current only if's not already such
   )
  ); if
 ); make_dimstyle
 
 ; here starts C:RXD

 ; define some constants
 (setq LAYER_NAME "DIM")
 (setq DIMSTYLE_NAME "AA DIM I")
   
 (setq savOSmode (getvar "osmode")) ; save osnap
 
 (if (and
      (setq p13 (getpoint "\nSpecify first extension line origin: "))
      (setq p14 (getpoint p13 "\nSpecify second extension line origin: "))
      (setq p10 (getcorner p13 "\nDimension line location: "))
     )
  (progn
   (setq p12 (list (car p13) (cadr p10)))
   (setq p15 (list (car p10) (cadr p13)))

   (setvar "osmode" 0)
   
   (if (setq ss (ssget "f" (list p13 p12 p10 p15) '((0 . "line,solid,mtext,insert"))))
    (progn
     (command "_.erase" "_si" ss)
     (make_layer)
     (make_dimstyle)
     (command "_.dimlinear" p13 p14 p10)
     (command "_.chprop" "_si" "_last" "_layer" LAYER_NAME "")
    )
   )

   (setvar "osmode" savOSmode) ; restore osnap
  )
 ); if

 (princ)
); C:RXD

Message 3 of 24
pendean
in reply to: Anonymous

Can you post a sample DWG file that you are trying to fix?


Message 4 of 24
Anonymous
in reply to: pendean

here is a test file... you will see the exploded dimensions.

 

thanx

Message 5 of 24
Anonymous
in reply to: Moshe-A

Hi Moshe-A,

This doesnt seem to remove the old text.  all i really need is the abilty to pick the lines of text to use for the new dimension.  Im not sure how hard this is to do but i tried and i cant figure it out.

 

thanx

Message 6 of 24
pendean
in reply to: Anonymous

Thanks for the sample file: your drawing is not to scale, is this a manufacturer supplied generic detail or a from-PDF conversion? You are going to open up a can of worms when you replace those text objects with actual dimensions.

 

 

Capture.PNG 

Looks like your content was deliberately drawn out of scale.

 

 

 

Message 7 of 24
Moshe-A
in reply to: Anonymous

@Anonymous,

 

ok, here is the fix and it's now support any rotated dimension.

the lisp starts by asking a dimension angle (same as dimrotated command), this angle will be suggest as default  next time. if you do not know the angle, just snap to the dimension line by 2 points.

than a virtual boundary is calculated around the dimension line to be used by (ssget "cp") sel-method to catch all objects 'under'. if some exploded objects are falling outside this boundary they wont be deleted. for example if the arrows falls outside the dimension line they won't be 'seen' by the (ssget).

i added  a new constat variable for you to control the width of that boudary:

(setq BOUNDARY_FACTOR 0.25)

it's   1/4 of dimension text height, so if you encounter a place where it's not working try to increase that value.

and last, your target dimstyle is not exist in text(s).dwg and the existing dimensions are not syncronized with the current dimension style. you must fix this before running this lisp.

 

enjoy

moshe

 

; Recover eXploded Dimension
(defun c:RXD (/ ask_angle make_layer make_dimstyle calcP12 sht-pt ; local functions
	        LAYER_NAME DIMSTYLE_NAME BOUNDARY_FACTOR savOSmode ang0 p13 p14 p10 p12 ss ;| local variables |;)

 (defun ask_angle (msg def / ask)
  (if (not (setq ask (getangle (strcat "\n" msg " <" (angtos def) ">: "))))
   (setq ask def)
   (setq def ask)
  )
 ); ask_angle

   
 (defun make_layer (/ tbl)
  (if (null (setq tbl (tblsearch "layer" LAYER_NAME))) ; is layer exist?
   (command "_.layer" "_new" LAYER_NAME "_color" 6 LAYER_NAME "")
   ; else
   (if (/= (cdr (assoc '62 tbl)) 6) ; set LAYER_NAME color 6 only if it has something else
    (command "_.layer" "_color" 6 LAYER_NAME "")
   )
  ); if
 ); make_layer

 (defun make_dimstyle ()
  (if (null (tblsearch "dimstyle" DIMSTYLE_NAME)) ; is dimstyle exist?
   (command "dimstyle" "save" DIMSTYLE_NAME)
   ; else 
   (if (/= (strcase (getvar "dimstyle")) DIMSTYLE_NAME)
    (command "_.dimstyle" "_restore" DIMSTYLE_NAME) ; set DIMSTYLE_NAME current only if's not already such
   )
  ); if
 ); make_dimstyle
  
 (defun calcP12 (/ t12a t12b t15)
  (setq t12a (polar p10 ang0 (distance p13 p10)))
  (setq t12b (polar p10 (+ ang0 pi) (distance p13 p10)))
  (setq t15 (polar p13 (angle p14 p10) (distance p13 p10)))
  
  (vl-some
   '(lambda (x)
      (inters p10 x p13 t15)
    )
   (list t12a t12b)
  )
 ); calcP12
  
 (defun sht-pt (base node level / pt)
   (setq pt (polar base
		      (if (eq node 'P12)
		       (angle p10 p12)
		       (angle p12 p10)
		      )
	            (* (getvar "dimtxt") (getvar "dimscale") BOUNDARY_FACTOR)
            )
   )

   (polar pt
            (if (eq level 'BELLOW)
	      (angle p12 p13)
	      (angle p13 p12)
	    )
	    (* (getvar "dimtxt") (getvar "dimscale") BOUNDARY_FACTOR)
   ); polar
 ); sht-pt
  
 ; here starts C:RXD
 (setvar "cmdecho" 0)
 (command "._undo" "_begin")

 ; set some constants
 (setq LAYER_NAME "DIM")
 (setq DIMSTYLE_NAME "AA DIM I")
 (setq BOUNDARY_FACTOR 0.25)
   
 (setq savOSmode (getvar "osmode")) ; save osnap
 
 (if (and
       (setvar "userr1" (setq ang0 (ask_angle "Specify angle of dimension line" (getvar "userr1"))))
       (setq p13 (getpoint "\nSpecify first extension line origin: "))
       (setq p14 (getpoint p13 "\nSpecify second extension line origin: "))
       (setq p10 (getpoint p14 "\nDimension line location: "))
       (setq p12 (calcP12) ang0 (angle p10 p12))
       (setq ss (ssget "cp" (list (sht-pt p12 'P12 'BELLOW)
			          (sht-pt p12 'P12 'ABOVE)
				  (sht-pt p10 'P10 'ABOVE)
				  (sht-pt p10 'P10 'BELLOW)
			    )
		            '((0 . "line,solid,text,mtext,insert"))
		)
      ); setq
     ); and
  (progn
   (setvar "osmode" 0)
   (command "_.erase" "_si" ss)
   (make_layer)
   (make_dimstyle)
   (command "_.dimrotated" (angtos ang0) p13 p14 p10)
   (command "_.chprop" "_si" "_last" "_layer" LAYER_NAME "")
   (setvar "osmode" savOSmode) ; restore osnap
  )
 ); if
  
 (command "._undo" "_end")
 (setvar "cmdecho" 1)
  
 (princ)
); C:RXD
Message 8 of 24
Anonymous
in reply to: pendean

Hi Pendean,

Yes i know this is out of scale.  It is just a generic template our company uses.  Really all i want to be able to do is pick the existing text on the expoded out of scale dimension and use it for my new demension automatically after i place the location of the dimension.

 

thanx

Message 9 of 24
Anonymous
in reply to: Moshe-A

Hi Moshe-A,  thank you very much for helping me with this but i think i have made this more complicated than it need to be.  Really all i would like to be able to do is pick the existing dimension text, then place my new dimension and after i have made my final click the actual dimesion will be replace with the text i picked from the old exploded text.  all the layer colors and everything else i can deal with.  Attached is a sample of how i do this with multileaders. 

 

again thank you very much for your help

Message 10 of 24
Kent1Cooper
in reply to: Anonymous


@Anonymous wrote:

.... pick the existing dimension text, then place my new dimension and after i have made my final click the actual dimesion will be replace with the text i picked from the old exploded text.  ....


 

For that assign-the-text-content part alone, in barest-bones terms, and involving User selection:

(defun C:TEST (/ txt dim)
  (setq
    txt (vlax-ename->vla-object (car (entsel "\nText: ")))
    dim (vlax-ename->vla-object (car (entsel "\nDimension: ")))
  )
  (vla-put-TextOverride dim (vla-get-TextString txt))
)

 

It can have the User selection of the Dimension replaced by (entlast) after drawing the Dimension, easily enough, but otherwise, first I have questions:

 

You talk about selecting the pieces left over from what was a Dimension, to Erase them.  Is the idea that the routine would find the Text object from among those pieces for you?  A routine could figure that out if there's one  Text object for it to find, but will run into trouble in your lower example in the sample drawing, which involves two  Text objects.  How should such a situation be handled?

 

In Message 1, you describe the process in terms of an Aligned  Dimension, but have a Linear  one in the code.  From the sample drawing, the latter seems like the appropriate type, but please confirm that.

 

[As an aside, I would not use the OSMODE value in Message 1's code.  That includes the NEArest mode, which will almost always "win out" over the rest of them, so the others will be pointless.  And you could easily get it Dimensioned to incorrect places.]

 

EDIT:

For one with only one piece of Text, try this:

(defun C:DimReplace (/ parts txtss)
  (command
    "_.LAYER" "_make" "DIM" "_color" "6" "" ""
    "dimstyle" "r" "AA DIM I"
  ); command
  (prompt "\nTo delete exploded-Dimension pieces for replacement with Dimension,")
  (setq
    parts (ssget "_:L" '((0 . "LINE,TEXT,SOLID")))
    txtss (ssget "_P" '((0 . "TEXT")))
  ); setq
  (setvar 'osmode 247)
  (command-s "_.dimlinear")
  (vla-put-TextOverride
    (vlax-ename->vla-object (entlast))
    (vla-get-TextString (vlax-ename->vla-object (ssname txtss 0)))
  ); ...put...Override
  (command "_.erase" parts "")
  (princ)
)

It assumes the Dimension Style exists, and is of appropriate characteristics [e.g. Text size] to replace the exploded pieces.

 

If the selection before making the Dimension includes more than one piece of Text, it will use one of them as the source for the override, but you will have no control over which one.

Kent Cooper, AIA
Message 11 of 24
Anonymous
in reply to: Kent1Cooper

You talk about selecting the pieces left over from what was a Dimension, to erase them.  Is the idea that the routine would find the Text object from among those pieces for you?  No I would pick the text only.

 

A routine could figure that out if there's one Text object for it to find, but will run into trouble in your lower example in the sample drawing, which involves two Text objects.  How should such a situation be handled?  It would typically be one line of text and in the cases where it was more than one line i could convert it to Mtext.  Although it would be nice to be able to pick as much text as you want keeping in mind this lisp is to illuminate steps.

 

In Message 1, you describe the process in terms of an Aligned Dimension, but have a Linear one in the code.  From the sample drawing, the latter seems like the appropriate type, but please confirm that. Sorry I am build a lisp for each.  I figured once one figured out it would be easy enough for me to modify it to fit the other.

 

[As an aside, I would not use the OSMODE value in Message 1's code.  That includes the NEArest mode, which will almost always "win out" over the rest of them, so the others will be pointless.  And you could easily get it Dimensioned to incorrect places.]  I was just trying to turn on the snap in case it was off.

 

All that aside I was able to hunt around the internet and find enough chunks of lisps to piece this together (see below).  It’s not very pretty but it will give you an idea of what I want. I noticed when I select the text it doesn’t highlight it.  Also it would be nice to eliminate the step of having to pick the dimension where you want the text pasted.  Can you help me with modifying to make it more efficient?

 

Thanks for your help

 

(defun c:DRB (/ lead A B)
(setq A (cdr (assoc 1 (entget (car (entsel "Select TEXT to copy: "))))))
(princ "Select objects to delete. ")
(setq lead (ssget))
(command "erase" lead "")
(command "__dimlinear" "\\" "\\" "\\")
(while (setq B (car (entsel "Select TEXT to paste: ")))
(setq C (entget B))
(entmod (subst (cons 1 A)(assoc 1 C)C))
(if (or (= (cdr (assoc 0 C)) "POLYLINE")(= (cdr (assoc 0 C)) "INSERT"))
(entupd B)))
(princ)
)

 

Message 12 of 24
Anonymous
in reply to: Anonymous

Hi Ken,

Sorry I didnt see that last lisp you build.  It works perfect.  The only thing that would make it better is if i could pick more that one line of text.

 

thanks again

Message 13 of 24
Kent1Cooper
in reply to: Anonymous


@Anonymous wrote:

... I didnt see that last lisp you build.  It works perfect.  The only thing that would make it better is if i could pick more that one line of text. ....


 

Something like this:

(defun C:DimReplace (/ parts txtss)
  (command
    "_.LAYER" "_make" "DIM" "_color" "6" "" ""
    "dimstyle" "r" "AA DIM I"
  ); command
  (prompt "\nTo delete exploded-Dimension pieces for replacement with Dimension,")
  (setq
    parts (ssget "_:L" '((0 . "LINE,TEXT,SOLID")))
    txtss (ssget "_P" '((0 . "TEXT")))
  ); setq
  (if (> (sslength txtss) 1); more than 1 Text object in selection
    (progn ; then
      (command "_.txt2mtxt" txtss "")
      (setq txtss (ssadd (entlast))); Mtext-converted object only
      (ssadd (entlast) parts); put back in for Erasing later
    ); progn
  ); if
  (setvar 'osmode 247); [omitting NEArest]
  (command-s "_.dimlinear")
  (vla-put-TextOverride
    (vlax-ename->vla-object (entlast))
    (vla-get-TextString (vlax-ename->vla-object (ssname txtss 0)))
  ); ...put...Override
  (command "_.erase" parts "")
  (princ)
)

But depending on the relationships, you will sometimes need to edit the resulting Dimension text content for line-break location, etc.  And it needs those multiple Text objects to be plain Text, not already Mtext.  Minimally tested -- other peculiar circumstances [such as override formatting, maybe] could cause unexpected results.

 

Kent Cooper, AIA
Message 14 of 24
Anonymous
in reply to: Kent1Cooper

thank you Kent.  that worked awesome.

Message 15 of 24
Anonymous
in reply to: Anonymous

Also thanks to Moshe-A for helping.

Message 16 of 24
dani-perez
in reply to: Kent1Cooper

Hello Kent1Cooper, Recreating all types of dimensions would be very difficut, wouldnt it? it's just a question. Thanks.
Message 17 of 24
Kent1Cooper
in reply to: dani-perez


@dani-perez wrote:
Hello Kent1Cooper, Recreating all types of dimensions would be very difficut, wouldnt it? it's just a question. Thanks.

 

It might not be too difficult, but it would need to be done separately for every variety, or possibly with separate options  for every variety if within one command.  A routine wouldn't have any way of determining what kind of Dimension the exploded pieces came from.  It might be built to at least narrow down the possibilities  from the selection, if  the User can be counted on to be careful in picking all the pieces and only pieces that came from a single exploded Dimension.  If the selection includes any Arcs, it was probably an Angular or Arc-length Dimension; if it includes any non-orthogonal  Lines, it probably wasn't a "plain" Linear one, but could have been an Aligned or Rotated or Angular or Radius or Diameter or even Ordinate one, so that doesn't narrow it down much.  The User would still need to know the available types and which is appropriate to replace those pieces.

Kent Cooper, AIA
Message 18 of 24
dani-perez
in reply to: Kent1Cooper

Hello 

 

Message 19 of 24
Kent1Cooper
in reply to: dani-perez


@dani-perez wrote:


 

In the offer-options-in-one-command approach [minimally tested]:

(defun C:DimReplace (/ parts txtss dimtype)
  (command
    "_.LAYER" "_make" "YourDimensionLayerName" "_color" YourDimensionLayerColor "" ""
    "_.dimstyle" "_restore" "YourDimensionStyleName"
  ); command
  (prompt "\nTo delete exploded-Dimension pieces for replacement with Dimension,")
  (setq
    parts (ssget "_:L" '((0 . "LINE,*TEXT,SOLID")))
    txtss (ssget "_P" '((0 . "*TEXT")))
  ); setq
  (if (> (sslength txtss) 1); more than 1 Text object in selection
    (progn ; then
      (command "_.txt2mtxt" txtss "")
      (setq txtss (ssadd (entlast))); Mtext-converted object only
      (ssadd (entlast) parts); put back in for Erasing later
    ); progn
  ); if
  (setvar 'osmode 247); <--- EDIT for your preferred combination
  (initget 1 "ALigned ANgular ARc Diameter Horizontal Linear Ordinate RAdius ROtated Vertical")
  (setq dimtype (getkword "\nType of Dimension [ANgular/ARc/Diameter/Horizontal/Linear/Ordinate/RAdius/ROtated/Vertical]: "))
  (command-s (strcat "_.dim" dimtype))
  (vla-put-TextOverride
    (vlax-ename->vla-object (entlast))
    (vla-get-TextString (vlax-ename->vla-object (ssname txtss 0)))
  ); ...put...Override
  (command "_.erase" parts "")
  (princ)
)

I find that unlike some older versions, in Acad2019 the text piece left over from an Exploded Dimension is Mtext, not plain Text as assumed in the earlier routine -- hence the *TEXT in the (ssget) filter lists.  But if it's multi-line, it's still one  Mtext object, so it doesn't run up against the TXT2MTXT command not liking to be given Mtext.

 

I included Horizontal and Vertical options, because those commands are still accepted, even though Help doesn't include them in the Commands list.  If you would always just use the Linear option in either case, you can shorten the (initget) string and the prompt by removing those two.

 

Same caveats as before [e.g. it assumes the Style exists and is at appropriate sizing].

Kent Cooper, AIA
Message 20 of 24
dani-perez
in reply to: Kent1Cooper

Hello 

 

Thanks again for your help!!

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Technology Administrators


Autodesk Design & Make Report