Dimensions

[maahee]

(defun C:bm ()

  (setvar "osmode" 0)			; Turn off OSNAP

  (setq obj (ssget '((0 . "LWPOLYLINE,ARC"))))
  (setq num (sslength obj))
  (setq i 0)
  (repeat num
    (setq obj1 (ssname obj i))
    (setq db (entget obj1))
   
    (if	(= (cdr (assoc 0 db)) "ARC")
      (progn
       (setq ct (cdr (assoc 10 db)))
    (setq rd (cdr (assoc 40 db)))
	(setq ang1 (* (cdr (assoc 50 db)) (/ 180.0 pi))
	      ang2 (* (cdr (assoc 51 db)) (/ 180.0 pi))
	)
	(setq p1 (polar ct ang1 rd))
	(setq p2 (polar ct ang2 rd))
	(command "_.dimradius" "_non" p1 "_non" p2 "")
	(command "_.dimarc" "_non" p1 "_non" p2 "")
      )					;progn

      (progn				;polyline arc segment
;;;;;code
	(if (/= bulge 0.0)
	  (progn
	    (setq p1 (nth r ptlist))
	    (setq p2 (nth (+ r 1) ptlist))

	    (command "_.dimradius" "_non" p1 "_non" p2 "")
	    (command "_.dimarc" "_non" p1 "_non" p2 "") ;
	  )				;progn
	)				;if
      )					;progn
    )

    (setq i (1+ i))

  )					;repeat end

					; Turn off OSNAP
  (setvar "osmode" 511)

  (princ)
)					;end  

1. It does not obtain dimensions for all arc objects.

2. It does not obtain the dimensions of all polyline arc segments.

(command "_.dimradius" "_non" p1 "_non" p2 "")
        (command "_.dimarc" "_non" p1 "_non" p2 "") ;

 

[devitg]

1 hour ago, maahee said:

(defun C:bm ()

  (setvar "osmode" 0)			; Turn off OSNAP

  (setq obj (ssget '((0 . "LWPOLYLINE,ARC"))))
  (setq num (sslength obj))
  (setq i 0)
  (repeat num
    (setq obj1 (ssname obj i))
    (setq db (entget obj1))
   
    (if	(= (cdr (assoc 0 db)) "ARC")
      (progn
       (setq ct (cdr (assoc 10 db)))
    (setq rd (cdr (assoc 40 db)))
	(setq ang1 (* (cdr (assoc 50 db)) (/ 180.0 pi))
	      ang2 (* (cdr (assoc 51 db)) (/ 180.0 pi))
	)
	(setq p1 (polar ct ang1 rd))
	(setq p2 (polar ct ang2 rd))
	(command "_.dimradius" "_non" p1 "_non" p2 "")
	(command "_.dimarc" "_non" p1 "_non" p2 "")
      )					;progn

      (progn				;polyline arc segment
;;;;;code
	(if (/= bulge 0.0)
	  (progn
	    (setq p1 (nth r ptlist))
	    (setq p2 (nth (+ r 1) ptlist))

	    (command "_.dimradius" "_non" p1 "_non" p2 "")
	    (command "_.dimarc" "_non" p1 "_non" p2 "") ;
	  )				;progn
	)				;if
      )					;progn
    )

    (setq i (1+ i))

  )					;repeat end

					; Turn off OSNAP
  (setvar "osmode" 511)

  (princ)
)					;end  

1. It does not obtain dimensions for all arc objects.

2. It does not obtain the dimensions of all polyline arc segments.

(command "_.dimradius" "_non" p1 "_non" p2 "")
        (command "_.dimarc" "_non" p1 "_non" p2 "") ;

 

@maahee Please upload you sample,dwg . as to test 

 

[Tsuky]

A start with this ?

(vl-load-com)
(defun make_mlead (pt o r obj / ptlst arr nw_obj)
  (setq
    ptlst (append pt (polar pt o r))
    arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
  )
  (vlax-safearray-fill arr ptlst)
  (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
  (vla-put-contenttype nw_obj acMTextContent)
  (vla-put-textstring nw_obj (strcat "{\\fArial|b0|i0|c0|p34;R=" (rtos r 2 2) "\\P\\C1You can put here other value}"))
  (vla-put-layer nw_obj (getvar "CLAYER"))
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (if (> (car ptlst) (cadddr ptlst))
    (progn
      (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
      (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
      (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
    )
    (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
  )
  (vla-update nw_obj)
)
(defun c:rad2lead ( / ent dxf_ent typ_ent mkv vector vlaobj prm id_rad AcDoc Space ent pt1 pt2 pt x)
  (while (not (setq ent (entsel "\nSelect a bulge: "))))
  (setq typ_ent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))))
  (cond
    ((or
      (eq typ_ent "ARC")
      (eq typ_ent "CIRCLE")
      (eq typ_ent "LWPOLYLINE")
      (and
        (eq typ_ent "POLYLINE")
        (zerop (boole 1 120 (cdr (assoc 70 dxf_ent))))
      )
     )
      (if (or (> (fix (car (trans (cadr ent) 1 0))) 1E6) (> (fix (cadr (trans (cadr ent) 1 0))) 1E6))
        (setq mkv T vector (trans (cadr ent) 0 0 T) vlaobj (vlax-ename->vla-object (car ent)))
        (setq mkv nil)
      )
      (if mkv (vla-move vlaobj (vlax-3d-point (trans (cadr ent) 1 0)) (vlax-3d-point '(0.0 0.0 0.0))))
      (setq id_rad
        (distance
          '(0 0)
          (trans
            (vlax-curve-getsecondderiv (car ent)
              (setq prm
                (vlax-curve-getparamatpoint (car ent)
                  (vlax-curve-getclosestpointto (car ent) (if mkv '(0.0 0.0 0.0) (trans (cadr ent) 1 0)))
                )
              )
            )
            0
            (car ent)
            T
          )
        )
      )
      (if mkv (vla-move vlaobj (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point vector)))
      (cond
        ((not (zerop id_rad))
          (setq
            AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
            Space
            (if (= 1 (getvar "CVPORT"))
              (vla-get-PaperSpace AcDoc)
              (vla-get-ModelSpace AcDoc)
            )
          )
          (vla-startundomark AcDoc)
          (setq ent (car ent))
          (if (member typ_ent '("POLYLINE" "LWPOLYLINE"))
            (setq
              pt1 (vlax-curve-getPointAtParam ent (fix prm))
              pt2 (vlax-curve-getPointAtParam ent (1+ (fix prm)))
              pt (vlax-curve-getPointAtParam ent (+ (fix prm) 0.5))
            )
            (setq
              pt1 (vlax-curve-getStartPoint ent)
              pt2 (vlax-curve-getEndPoint ent)
              pt (vlax-curve-getPointAtDist ent (* 0.5 (- (vlax-curve-getDistAtPoint ent pt2) (vlax-curve-getDistAtPoint ent pt1))))
            )
          )
          (setq
            x (* (fix (/ (angle (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5)) pt) (* 0.125 pi))) 0.125 pi)
            x (+ x (rem x (* 0.25 pi)))
          )
          (make_mlead pt x id_rad (vlax-ename->vla-object ent))
          (vla-regen AcDoc acactiveviewport)
          (vla-endundomark AcDoc)
        )
        (T (princ "\nSegment have no bulge."))
      )
    )
    (T (princ "\nThis object can't be availaible for this function!"))
  )
  (prin1)
)