Arc dim with radius and length

Hi, I have a major problem. I found on the net a lisproutine that measures the radius and length of an arc. Great! I made some adjustments like placing text in front of the measurements, but that's how far my knowledge of autolisp goes

Now I need help. I really want the text automatically aligned with the arc and placed above and in the middle of the dimension line.

As you can see (picture) the dimension of the text, the arrowheads and the extension lines are oversized.

Is there a possibility to adjust this problem in the routine? For instance, once, before you start to measure your arcs?

Thanks!

(defun c:arcRL (/ cm fd ar1 ar2 ar3 ar4 ar5 tab oba ) 
(vl-load-com) 
 (setq cm (getvar "cmdecho")) 
 (setvar"cmdecho" 0) 
 (setq fd (getvar "fielddisplay")) 
 (if (/= fd 0)(setvar"fielddisplay" 0)) 
   (setq ar1 (entsel "\nSelect an Arc: ")) 
   (setq ar2 (car ar1)) 
   (setq tab (vlax-ename->vla-object ar2))
   (setq oba (vla-get-objectid tab)) 
   (setq ar3 (strcat "L=%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " 
                     (rtos oba 2 0) 
                     ">%).ArcLength [url="file://\\f"]\\f[/url] \"%ct8[1000]%pr0%lu2%ds44>%"))
    (setq ar4 (strcat "R=%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " 
                     (rtos oba 2 0) 
                     ">%).radius [url="file://\\f"]\\f[/url] \"%pr2%lu2%ds44>%"))
    (setq ar5 (strcat " "))

   (command "dimangular" ar1 "t" ar5  pause) 
   (command "mtext" pause  pause ar4 ar3 )
 (setvar"fielddisplay" fd) 
 (setvar "cmdecho" cm)  
(princ)
) 

Hi, I have a major problem. I found on the net a lisproutine that measures the radius and length of an arc. Great! I made some adjustments like placing text in front of the measurements, but that's how far my knowledge of autolisp goes

Now I need help. I really want the text automatically aligned with the arc and placed above and in the middle of the dimension line.

As you can see (picture) the dimension of the text, the arrowheads and the extension lines are oversized.

Is there a possibility to adjust this problem in the routine? For instance, once, before you start to measure your arcs?

Thanks!

Give this a shot

(defun c:arcRL (/ acsp ar1 ar2 ar3 ar4 arclen cm cpt dim ep fd
   midp mtext mtxtpt oba rad rot sp tab txtpt) 
(vl-load-com)

 (setq acsp (vla-get-block
       (vla-get-activelayout
  (vla-get-activedocument
    (vlax-get-acad-object)))))
 (setq cm (getvar "cmdecho")) 
 (setvar"cmdecho" 0) 
 (setq fd (getvar "fielddisplay")) 
 (if (/= fd 0)(setvar"fielddisplay" 0)) 
   (setq ar1 (entsel "\nSelect an Arc: ")) 
   (setq ar2 (car ar1)) 
   (setq tab (vlax-ename->vla-object ar2))
   (setq sp (vlax-curve-getstartpoint tab)
  ep (vlax-curve-getendpoint tab)
  cpt (vlax-get tab 'Center)
  rad (vlax-get tab 'Radius)
  arclen (vlax-get tab 'ArcLength)
  midp (mapcar (function (lambda (a b)(/ (+ a b) 2))) sp ep)
  txtpt (trans (polar cpt (angle cpt midp)(+ rad (* 5 (getvar "DIMTXT"))))1 0)
  mtxtpt (trans (polar txtpt (angle midp cpt) (* 2.5 (getvar "DIMTXT")))1 0)
  rot (- (angle cpt midp)(/ pi 2))
  )
   (setq oba (vla-get-objectid tab)) 
   (setq ar3 (strcat "L=%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " 
                     (rtos oba 2 0) 
                     ">%).ArcLength [url="file://\\f"]\\f[/url] \"%ct8[1000]%pr0%lu2%ds44>%"))
    (setq ar4 (strcat "[url="file://\\PR=%<\\AcObjProp"]\\PR=%<\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " 
                     (rtos oba 2 0) 
                     ">%).Radius [url="file://\\f"]\\f[/url] \"%pr2%lu2%ds44>%"))

   (setq dim (vlax-invoke acsp 'AddDimAngular cpt sp ep txtpt))
   (vla-put-textrotation dim rot)
   (setq mtext (vlax-invoke acsp 'AddMText mtxtpt 0.0 (strcat ar3 ar4)))   
   (vla-put-attachmentpoint mtext acAttachmentPointMiddleCenter)
   (vlax-invoke mtext 'Rotate cpt rot)
   (vlax-put mtext 'InsertionPoint  mtxtpt)
   (vla-put-height mtext (getvar "DIMTXT"))
 (setvar"fielddisplay" fd) 
 (setvar "cmdecho" cm)  
(princ)
)

~'J'~

Hi Fixo,

Thanks for your effort. The one-click function and the alignment works perfectly. Still a few points to change.

Is it possible to remove the degrees between the dimlines and can the text placed above the dimline?

On the picture, the left image is how it is now and on the right side is how I would like to be, if it's possible.

grz W

Hi Fixo,

 

Thanks for your effort. The one-click function and the alignment works perfectly. Still a few points to change.

Is it possible to remove the degrees between the dimlines and can the text placed above the dimline?

On the picture, the left image is how it is now and on the right side is how I would like to be, if it's possible.

 

grz W

 

[ATTACH]21005[/ATTACH]

Try this one instead

(defun c:arcRL (/ acsp arcent arclen arcobj cm cpt oldht dimht dimobj ep fd id
   lenstr midp mtext mtxtpt rad radstr rot sp sset txtpt) 
(vl-load-com)

 (setq acsp (vla-get-block
       (vla-get-activelayout
  (vla-get-activedocument
    (vlax-get-acad-object))))
)
 (setq cm (getvar "cmdecho")) 
 (setvar"cmdecho" 0)

 (setq fd (getvar "fielddisplay")) 
 (if (/= fd 0)(setvar "fielddisplay" 0))

 (if (= (setq oldht(getvar "dimtxt")) 0)
   (progn
     (initget 7)
     (setq dimht (getreal "\nEnter font height for multiline text: "))
     (setvar "dimtxt" dimht)
     )
   )
 (prompt "\n  >>  Select arcs  >>")
 (if (setq sset (ssget (list (cons 0 "ARC"))))

   (while (setq arcent (ssname sset 0)) 

   (setq arcobj (vlax-ename->vla-object arcent))
   (setq sp (vlax-curve-getstartpoint arcobj)
  ep (vlax-curve-getendpoint arcobj)
  cpt (vlax-get arcobj 'Center)
  rad (vlax-get arcobj 'Radius)
  arclen (vlax-get arcobj 'ArcLength)
  midp (vlax-curve-getclosestpointto arcobj
  (vlax-curve-getpointatdist arcobj
    (/ arclen 2.))
  )
  txtpt (trans (polar cpt (angle cpt midp)(+ rad (* 5 (getvar "DIMTXT")))) 1 0)
  )
   (setq id (vla-get-objectid arcobj)) 
   (setq lenstr (strcat "L=%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " 
                     (rtos id 2 0) 
                     ">%).ArcLength [url="file://\\f"]\\f[/url] \"%ct8[1000]%pr0%lu2%ds44>%"))
    (setq radstr (strcat "[url="file://\\PR=%<\\AcObjProp"]\\PR=%<\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] " 
                     (rtos id 2 0) 
                     ">%).Radius [url="file://\\f"]\\f[/url] \"%pr2%lu2%ds44>%"))

   (setq dimobj (vlax-invoke acsp 'AddDimAngular cpt sp ep txtpt))
   (setq mtxtpt (trans (polar midp (angle cpt midp) (* 7 (getvar "DIMTXT"))) 1 0)
  rot (- (angle cpt midp)(/ pi 2)))
   (setq mtext (vlax-invoke acsp 'AddMText mtxtpt 0.0 (strcat lenstr radstr)))   
   (vla-put-attachmentpoint mtext acAttachmentPointMiddleCenter)
   (vlax-invoke mtext 'Rotate cpt rot)
   (vlax-put mtext 'InsertionPoint  mtxtpt)
   (vla-put-height mtext (getvar "DIMTXT"))
     (vla-put-textoverride dimobj " ")
   (vla-update dimobj)
(ssdel arcent sset)
   )
  )
 (setvar"fielddisplay" fd)
 (setvar "dimtxt" oldht)
 (setvar "cmdecho" cm)  
(prin1)
)

~'J'~

Great job Fixo! It's almost wat I need. But still few things I noticed while I was using it. I saw in the code that you can enter the heigth of the text but it doesn't work when I run the script. And a second thing is the direction of the dimline and text. It's always in the same direction and for some cases it could be bad for the layout of the drawing. Can you fix this like the example on the right side of the picture below?

Thx!!

Great job Fixo! It's almost wat I need. But still few things I noticed while I was using it. I saw in the code that you can enter the heigth of the text but it doesn't work when I run the script. And a second thing is the direction of the dimline and text. It's always in the same direction and for some cases it could be bad for the layout of the drawing. Can you fix this like the example on the right side of the picture below?

Thx!!

 

[ATTACH]21018[/ATTACH]

Sorry, I can't, it's out of my programming level

~'J'~

Sorry, I can't, it's out of my programming level

 

~'J'~

Ok Fixo, no problem. Thanks for the good work!

grz