Jump to content

Dimensions

maahee

By maahee
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

maahee Enthusiast

maahee

Posted
Posted 
(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 Mentor

devitg

Posted
Posted
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 

 

  • Thanks 1
Tsuky Community Regular

Tsuky

Posted
Posted

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

 

  • Thanks 1
GLAVCVS Experienced

GLAVCVS

Posted
Posted
9 hours 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 "") ;

 

 

 

Your code, ready.

  

(defun C:bm (/ obj num i obj1 db ct rd ang1 ang2 p1 p2 r ptlist)

  (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)
	  ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) db))
	  i 0
    )

    (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
      (foreach l db
	(if (= (car l) 10)
	  (if p1
	    (if bulge
	      (progn
	        (command "_.dimradius" "_non" p1 "_non" (cdr l) "")
	        (command "_.dimarc" "_non" p1 "_non" (setq p1 (cdr l)) "") ;
	      )
	    )
	    (setq p1 (cdr l))
	  )
	  (if (= (car l) 42) (setq bulge (/= (cdr l) 0.0)))
	)
	
	      
	    
;;;	(if (/= bulge 0.0)
;;;	  (progn
;;;	    (setq p1 (nth i ptlist))
;;;	    (setq p2 (nth (+ i 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)
)

 

  • Thanks 1
GLAVCVS Experienced

GLAVCVS

Posted
Posted

I've disabled some lines of your code that weren't working and added some new lines of code.
I hope this helps.

  • Thanks 1
maahee Enthusiast

maahee

Posted
  • Author
Posted (edited)

 

On 10/25/2025 at 6:06 PM, devitg said:

Please upload you sample,dwg . as to test 

@devitg sample dwg upload for reference

@GLAVCVS It may not function correctly, possibly due to the direction(clockwise or counterclockwise) of the arc or because it does not meet the point on the arc.

 

mb.dwg

Edited by maahee

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...