LISP - automatic coordinate dimensions for a free closed polyline

[Anonymous]

Dear community,

I'm working on Autocad Mechanical 2018 and I am looking for a LISP for automatic coordinate dimensioning for a free closed polyline. I found many LISPs and tested them all, unfortunately they either only work for orthogonal objects (base plate) or they only have linear dimensions.

The coordinate dimensions should look like this:

- UCS set to world

- with specific dimension style "AM_ISO_35mm"

- at each vertex of the polyline
- scale by scaling area (AMSCAREA) in which you are currently dimensioning

- zero points (starting points) - see example

- the polyline must remain a polyline, because it is important for further use

The double coordinate dimensions (e.g. right / left and top / bottom) will be removed later manually (via power-delete)

An example (DWG see attachement):

Many thanks in advance for your support

 

[pbejse]

Neo: Whoa, deja vu.
Trinity: What did you just say?
Neo: Nothing, I just had a little deja vu.
...
Trinity: Deja vu is usually a glitch in the Matrix. It happens when they change something.

[kajanthangavel · Accepted solution]

Try This.

Simple code

(defun c:autodim (/ n plobj minpt maxpt npt xpt e g x y f i)
; Kajanthangavel 18.06.2020
(defun *error* (errmsg)
	(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
		(princ (strcat "\nError: " errmsg))
	)
    (mapcar 'setvar svnames svvals)
	(command "ucs" "world")
    (princ)
)
(setq	svnames '(osmode cmdecho blipmode plinewid)
		svvals (mapcar 'getvar svnames)
)
(mapcar 'setvar svnames '(0 0 0 0))
(if (setq ss (ssget ":L" '((0 . "*polyline"))))
        (progn
            (repeat
					(setq n (sslength ss))
					(setq plobj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
					(setq sset (ssname ss (setq n (1+ n))))
					(vla-getboundingbox plobj 'minpt 'maxpt)
					(setq npt (vlax-safearray->list minpt))
					(setq xpt (vlax-safearray->list maxpt))
					
					(command "ucs" npt "")
					(princ xpt)
					
					
					(if (setq s ss)
					(progn
						
						
						((lambda (i / sset e)
							(while
								(setq sset (ssname s (setq i (1+ i))))
								(setq e (entget sset))
									(foreach f e
										(if	(= (car f) 10)
											(progn
												(setq g (list (cadr f) (caddr f)))
												;(setq g (trans g 0 1))
												(setq x (car g))
												(setq y (cadr g))
												(princ (list x y))

												(command "._dimordinate" (list (- x (car npt)) (- y (cadr npt))) "x" (list (- x (car npt)) (+ (- (cadr xpt) (cadr npt)) 60) ))
												(command "._dimordinate" (list (- x (car npt)) (- y (cadr npt))) "x" (list (- x (car npt)) (- (- (cadr xpt) (cadr xpt)) 60) ))

												(command "._dimordinate" (list (- x (car npt)) (- y (cadr npt))) "y" (list (+ (- (car xpt) (car npt)) 60) (- y (cadr npt)) ))
												(command "._dimordinate" (list (- x (car npt)) (- y (cadr npt))) "y" (list (- (- (car xpt) (car xpt)) 60) (- y (cadr npt)) ))
												
												(command "pline" (list (+ (- (car xpt) (car npt)) 0) (+ (- (cadr xpt) (cadr npt)) 60))
																(list (+ (- (car xpt) (car xpt)) 0) (+ (- (cadr xpt) (cadr npt)) 60)) "")
												
												(command "pline" (list (- (- (car xpt) (car npt)) 0) (- (- (cadr npt) (cadr npt)) 60))
																(list (- (- (car xpt) (car xpt)) 0) (- (- (cadr npt) (cadr npt)) 60)) "")

												(command "pline" (list (- (- (car npt) (car npt)) 60) (+ (- (cadr xpt) (cadr npt)) 0))
																(list (- (- (car npt) (car npt)) 60) (+ (- (cadr npt) (cadr npt)) 0)) "")
												
												(command "pline" (list (+ (- (car xpt) (car npt)) 60) (- (- (cadr xpt) (cadr npt)) 0))
																(list (+ (- (car xpt) (car npt)) 60) (- (- (cadr npt) (cadr npt)) 0)) "")




											)
										)
									)
						  
							)
						)
						-1
						)
					)
					(alert "Missed"))

            )
        )
    )
(command "ucs" "world")
(mapcar 'setvar svnames svvals)
)

i hope, this is help you.