Stretch text position of dimension

Hi guys,

I need your help

DIM.dwg

In the attached file, I'm trying to select a aligned/rotated dimension like this and

perform some stretching to reposition the dimension text like this:

I know that its easy to achieve it by modifying the dimension style (but I don't want to do that as I need to stretch only some of the dimensions like this).

As far the code has base start (but haven't figured out how to do the main thing):

(defun C:test ( / ent vla-obj pt1A pt2A pt3A pt4A pt5A )

(while 
	(not
		(and 
			(setq ent (car (entsel "\nSelect aligned or rotated dimension ")))
			(eq (cdr (assoc 0 (entget ent))) "DIMENSION")
			(setq vla-obj (vlax-ename->vla-object ent))
			(or
				(eq (vlax-get-property vla-obj 'ObjectName) "AcDbAlignedDimension")
				(eq (vlax-get-property vla-obj 'ObjectName) "AcDbRotatedDimension")
			)	
			
		)
	)
	(cond
		(   (= 7 (getvar 'errno))
			(princ "\nYou must select an object.")
		)
		(   (null ent)
			(princ "\nYou missed, try again.")
		)
	);cond	
);while


(progn
	(princ "\nyes")
	
	(defun DtR (d) ( * PI (/ d 180.0)))
	(setq pt1A (cdr (assoc 13 (entget ent)))) ; Definition pt
	(setq pt2A (cdr (assoc 14 (entget ent)))) ; Definition pt
	
	(setq pt3A (cdr (assoc 10 (entget ent)))) ; X of definition pt ; collinear to pt14
	(setq pt4A (polar pt3A (+ (angle pt2A pt3A) (DtR 90.0)) (distance pt1A pt2A)))
	(setq pt5A (cdr (assoc 11 (entget ent)))) ; X of MIDDLE pt of dimension text
	
	; perform checking
	(M-text pt1A "pt1A")
	(M-text pt2A "pt2A")
	(M-text pt3A "pt3A")
	(M-text pt4A "pt4A")
	(M-text pt5A "pt5A")
);progn

(princ)
);defun


(defun M-Text (pt str)
(entmakex 
	(list 
		(cons 0 "MTEXT")         
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbMText")
		(cons 10 pt)
		(cons 1 str)
		(cons 71 5)
	)
)
)	

Basically "grip" that point "pt5A" and stretch it to the middle of pt4A-pt3A:

I had attempt like this, but it failed:

(vlax-3D-point (vlax-get-property vla-obj 'TextPosition))

Also I've seen somewhere examples from LM with some function like vla-get-handle but I'm not sure is this is the method I need (basically I don't have any experience or knowledge about this).

Hi,

Have a play with this.

(if (setq ss (ssget "_:L" '((0 . "DIMENSION"))))
 (while (setq sn (ssname ss 0))
   (if (vl-some '(lambda (x) (and (= (car x) 100)
                                  (wcmatch (cdr x) "AcDbAlignedDimension,AcDbRotatedDimension")
                                  )
                   )
                (entget sn)
                )
     (vlax-put (vlax-ename->vla-object sn) 'TextPosition (mapcar '(lambda (j k) (* (+ j k) 0.5))
                                                                 (cdr (assoc 13 (entget sn)))
                                                                 (cdr (assoc 14 (entget sn)))
                                                                 )
               )
     )
   (ssdel sn ss)
   )
 )

Thanks alot, Tharwat!

Its lucky to have teacher like you!

Thanks alot, Tharwat!

You are most welcome.

Its lucky to have teacher like you!

It is too kind of you to say that.

I just had the chance to try and revise your code, Tharwat.

Earlier I thought that I would need to incorporate it with mine, but its working perfect!

I have just one question about what this row exactly means:

				(vl-some 
				'(lambda (x) 
					(and 
						(= (car x) 100)
						(wcmatch (cdr x) "AcDbAlignedDimension,AcDbRotatedDimension")
					)
				)
				(entget sn)
			)

When I "entget" a dimension like this I get few dotted pairs, containing "100":

((-1 . <Entity name: 7ff7c099ca10>) (0 . DIMENSION) (330 . <Entity name: 7ff7c09039f0>) (5 . 8A4A1) (100 . AcDbEntity) (67 . 0) (410 . Model) (8 . VLD_DIMENSIONS) (100 . AcDbDimension) (280 . 0) (2 . *D290) (10 65376.0 41633.0 0.0) (11 65405.2 41687.5 0.0) (12 0.0 0.0 0.0) (70 . 32) (1 . ) (71 . 5) (72 . 1) (41 . 1.0) (42 . 25.0) (73 . 0) (74 . 0) (75 . 0) (52 . 0.0) (53 . 0.0) (54 . 0.0) (51 . 0.0) (210 0.0 0.0 1.0) (3 . VLD_CenGoth-20-Oblique) (100 . AcDbAlignedDimension) (13 65401.0 41633.0 0.0) (14 65376.0 41633.0 0.0) (15 0.0 0.0 0.0) (16 0.0 0.0 0.0) (40 . 0.0) (50 . 0.0) (100 . AcDbRotatedDimension))

So I assume that it checks if one of those dotted pairs (100 . xxx) contains "AcDbAlignedDimension,AcDbRotatedDimension" , since something like this won't work:

(ssget "_:L" '((0 . "DIMENSION") (100 . "AcDbAlignedDimension,AcDbRotatedDimension" )))

EDIT: I just played a little more with it, and I think that I guessed. Assembled some interesting filter method:

; Example code that filters by dimension type "AcDbRotatedDimension" or "AcDbAlignedDimension"
; original code by Tharwat

(defun C:test ( / ss sn )
(if (setq ss (ssget "_:L" '((0 . "DIMENSION"))))
	(repeat (setq i (sslength SS)) ; iterate trought selection
		(setq sn (ssname SS (setq i (1- i))))
		(if 
			(vl-some 
				'(lambda (x) 
					(and 
						(= (car x) 100)
						(wcmatch (cdr x) "AcDbRotatedDimension")
					)
				)
				(entget sn)
			)
			(ssadd sn ss) ; <- leave this to select  "AcDbRotatedDimension"
			(ssdel sn ss)
			; (ssadd sn ss) ; <- leave this to select  "AcDbAlignedDimension"
		)
	)
)
(sssetfirst nil ss)
(princ)
)

Yes you analyzing the process very correctly and further more the use of function VL-SOME would save time if the criteria is found in lambda expression without being in need to cycle through all the DXF's codes.

Thank you for confirming!

When you provide awesome base like this, its easy to write varieties of awesome codes.

I did not see your edit when I replied to your post #5.

Actually there is no need to add the entity name to the selection set as long as it is already existed in the selection set so just ssdel the dimension that it is not rotated like this.

(if (not (vl-some '(lambda (x)  (and (= (car x) 100)
                                        (eq (cdr x) "AcDbRotatedDimension")
                                        )
                        )
              (entget sn)
                     )
            )
        (ssdel sn ss)
     )

And wcmatch function is not needed as before and a simple eq function would be enough.

Thanks for the additional revision,

I just used your code from post #2 (only defined it as a command function).

Usually I start such codes with "entsel" behaviour and when I'm done revising it - I do transition so it would work with ssget (iterating trought selection), since its hard for me to figure out what could possibly go wrong (when I use ssget).

I haven't reached studying this mapcar (function) lambda combination yet (but it doesn't mean that I can't assemble new codes, using it).

At the moment I'm slowly studying this object manipulation using VLA functions (retrieving properties from DUMP-ing objects) - which is why I raised the problem I had.

I recommend you to start using foreach function at the mean time instead of mapcar & lambda and by time you would be able to deal with them.

Have a play with this.

(if (setq ss (ssget "_:L" '((0 . "DIMENSION"))))
 (while (setq sn (ssname ss 0))
   (if (vl-some '(lambda (x) (and (= (car x) 100)
                                  (wcmatch (cdr x) "AcDbAlignedDimension,AcDbRotatedDimension")
                                  )
                   )
                (entget sn)
                )
     (vlax-put (vlax-ename->vla-object sn) 'TextPosition (mapcar '(lambda (j k) (* (+ j k) 0.5))
                                                                 (cdr (assoc 13 (entget sn)))
                                                                 (cdr (assoc 14 (entget sn)))
                                                                 )
               )
     )
   (ssdel sn ss)
   )
 )

Since DXF Groups 13 & 14 correspond to the endpoints of the dimension extension lines, you will receive unexpected results when applying this method to dimensions such as:

I would instead suggest the following approach:

([color=BLUE]defun[/color] c:cendimtxt ( [color=BLUE]/[/color] ent enx g10 g13 g14 idx int ocs sel vec )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] (LM:dimfilter '(0 1))))
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] idx ([color=BLUE]sslength[/color] sel))
           ([color=BLUE]if[/color] ([color=BLUE]setq[/color] ent ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] idx ([color=BLUE]1-[/color] idx)))
                     enx ([color=BLUE]entget[/color] ent)
                     ocs ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 210 enx))
                     g10 ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx)) 0 ocs)
                     g13 ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 13 enx)) 0 ocs)
                     g14 ([color=BLUE]trans[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 14 enx)) 0 ocs)
                     vec ([color=BLUE]mapcar[/color] '[color=BLUE]-[/color] g10 g14)
                     int ([color=BLUE]inters[/color] g10 ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] g10 ([color=BLUE]list[/color] ([color=BLUE]-[/color] ([color=BLUE]cadr[/color] vec)) ([color=BLUE]car[/color] vec) 0.0))
                                 g13 ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] g13 vec)
                                 [color=BLUE]nil[/color]
                         )
               )
               ([color=BLUE]vla-put-textposition[/color]
                   ([color=BLUE]vlax-ename->vla-object[/color] ent)
                   ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]/[/color] ([color=BLUE]+[/color] a b) 2.0)) int g10))
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; Dimension Selection Filter List  -  Lee Mac[/color]
[color=GREEN];; Constructs an appropriate filter list for the given dimension types[/color]
[color=GREEN];; lst - [lst] List of DXF Group 70 dimension types (0-6)[/color]
[color=GREEN];; e.g. Rotated & Aligned Dimensions: (LM:dimfilter '(0 1))[/color]

([color=BLUE]defun[/color] LM:dimfilter ( lst )
   ([color=BLUE]append[/color]
      '((0 . [color=MAROON]"*DIMENSION"[/color]) (-4 . [color=MAROON]"<OR"[/color]))
       ([color=BLUE]apply[/color] '[color=BLUE]append[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( typ ) ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]cons[/color] 70 ([color=BLUE]+[/color] typ x))) '(0 32 64 128 96 160 192 224))) lst))
      '((-4 . [color=MAROON]"OR>"[/color]))
   )
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

The above should also work under all UCS & View settings.

Lee,

I thought about this problem, but in my case the dimension extension lines are ontop of the both arrowheads.

Still its nice that you provide the perfect solution as always! So I have one more question about your code:

How do I add (cons 42 dimval) to your LM:dimfilter function, or to add it in the ssget function ?

My only untold addition on Tharwat's code was this:

(initget (+ 1 2 4))
(setq dimval (getreal "\nInput dimension value to filter for stretch: "))

(if (setq ss (ssget "_:L" (list (cons 0 "DIMENSION") (cons 42 dimval))))

As I don't want to remove that LM function from your original code (because I appreciate it).

I'm glad that you used another stretching method with using vla-put-textposition and vlax-3D-point so now I know that

(vlax-put (vlax-ename->vla-object ent) 'TextPosition pt)

isn't the only solution.

Thank you for replying, you're like the tooth fairy of this forum!

I would instead suggest the following approach:

That is frankly perfect.

I have just strictly followed the example which posted in this thread and what's more is that I think Grrr is just learning from the codes and not searching for a complete program.

That's is frankly perfect.

I have just strictly followed the example which posted in this thread and what's more is that I think Grrr is just learning from the codes and not searching for a complete program.

That is correct, its just hard to hide the joy when I strikethrough a task from my "ideas list", when Lee provides the perfect code.

Still I'm practicing with the VLA approach, since its easier to understand it than the plain list processing.

I hope that I don't annoy you with my questions (because I have alot and they are very different).

I hope that I don't annoy you with my questions (because I have alot and they are very different).

No at all, I am also getting the benefit of these practices by refreshing my memory with different approaches.

Still its nice that you provide the perfect solution as always!

That is frankly perfect.

Thank you both!

So I have one more question about your code:

How do I add (cons 42 dimval) to your LM:dimfilter function, or to add it in the ssget function ?

Since the ssget filter list operates using an implicit AND logic, you can simply append this condition to the filter list returned by my LM:dimfilter function, e.g.:

(ssget "_:L" (append (LM:dimfilter '(0 1)) (list (cons 42 dimval))))

Thank you for replying, you're like the tooth fairy of this forum!

Haha! You're most welcome!