[编程交流] 带半径和长度的弧尺寸

(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)
) 

(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)
)

(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)
)