Automatic dimension

[larsr2866]

Hello everyone,

I did a bit of searching on this forum for automatic dimensions. I have found some interesting tips for automatic dimensions with selecting rectangles, but i'd try something else.

I made a screenshot for what i want to achieve. I want to automatically create 2 dimensions between the first lines/polylines/objects/... where i am clicking in. 

I hope it's clear on the screenshot i took ? (the red circle is the position i click, and at that position i would have a vertical en horizontal dimension between the first lines/plines.)

I don't know if there are options for this?

Thanks in advance.

Lars

[devitg]

@larsr2866 , as ever , please upload your dwg . 

[Kent1Cooper · Accepted solution]

This seems to do that [in very limited testing].  It requires that:

1. the edges you want to Dimension between always run in orthogonal directions;

2. the edges are all Lines or Polylines [top-level ones, i.e. not nested in Blocks];

3. the edges are all separate objects from each other [it won't work to dimension a closed-Polyline rectangle];

4. no edge, if a Polyline, has some other part that comes closer to the picked point than the expected Dimension location [e.g. by turning a corner, or within an arc segment at the expected location];

5. there are no other Lines or Polylines between the picked point and the edges [there can be other kinds of things].

(defun C:DBW (/ find pt ptE ptN ptW ptS); = Dimension Both Ways
  (defun find (ang / n found)
    (setq n 0)
    (while (not (setq found (ssget "_C" pt (polar pt ang (setq n (1+ n))) '((0 . "LINE,*POLYLINE"))))))
    (ssname found 0)
  ); defun
  (setq
    pt (getpoint "\nPoint through which to Dimension Both Ways: ")
    ptE (vlax-curve-getClosestPointTo (find 0) pt)
    ptN (vlax-curve-getClosestPointTo (find (/ pi 2)) pt)
    ptW (vlax-curve-getClosestPointTo (find pi) pt)
    ptS (vlax-curve-getClosestPointTo (find (* pi 1.5)) pt)
  ); setq
  (command
    "_.dimlinear" "_non" ptE "__non" ptW "@"
    "_.dimlinear" "_non" ptN "__non" ptS "@"
  ); command
  (princ)
); defun

It uses whatever Dimension Style is current, and on the current Layer, so set those first; they could be built into the routine if desired.

[hak_vz · Accepted solution]

Try this

(defun c:dimhorver 
	;author hak_vz  
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;Thursday, September 2, 2021
	(
	/ *error* take pointlist3d sset->enameList get_intersections get_intersection_points
	adoc ss enameList pt line_hor line_hor_obj line_ver line_ver_obj i pl pr pu pb eo int_pts
	)
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(setvar 'cmdecho 1)
		(princ)
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	(defun pointlist3d (lst / ret) (while lst (setq	ret (cons (take 3 lst) ret) lst (cdddr lst))) (reverse ret))
	(defun sset->enameList (ss / i ret)
		; extracts elements name for all objects in a selection set into a list
		(if ss
			(repeat (setq i (sslength ss))
				(setq ret (cons (ssname ss (setq i (1- i))) ret))
			) ;_ end of repeat
		) ;_ end of if
	) ;_ end of defun
	(defun get_intersections	(obj1 obj2 / var)
		(setq var (vlax-variant-value (vla-intersectwith obj1 obj2 1)))
		(if (< 0 (vlax-safearray-get-u-bound var 1))(vlax-safearray->list var))
	)
	(defun get_intersection_points (obj1 obj2) (pointlist3d (get_intersections obj1 obj2)))
	(setvar 'cmdecho 0)
	(setq ss (ssget "_X" '((0 . "LWPOLYLINE,LINE,CIRCLE,ELLIPSE"))))
	(setq enameList (sset->enameList ss))
	(while (setq pt (getpoint "\nPick a point"))
		(setq line_ver
			(entmakex
				(list
					(cons 0 "XLINE")
					(cons 100 "AcDbEntity")
					(cons 100 "AcDbXline")
					(cons 10 (trans pt 1 0))
					(cons 11 '(0 1 0))
				)
			)
		)
		(setq line_ver_obj (vlax-ename->vla-object line_ver))
		(setq line_hor
			(entmakex
				(list
					(cons 0 "XLINE")
					(cons 100 "AcDbEntity")
					(cons 100 "AcDbXline")
					(cons 10 (trans pt 1 0))
					(cons 11 '(1 0 0))
				)
			)
		)
		(setq line_hor_obj (vlax-ename->vla-object line_hor))
		
		(setq i -1 pl nil pr nil)
		(while (< (setq i (1+ i)) (length enameList))
			(setq eo (vlax-ename->vla-object (nth i enameList)))
			(setq int_pts (get_intersection_points line_hor_obj eo))
			(foreach ipt int_pts
				(cond 
					((and (not pl)(< (car ipt) (car pt)))
						(setq pl ipt)
					)
					((and (not pr)(> (car ipt) (car pt)))
						(setq pr ipt)
					)
					(
						(and 
							(and pl)
							(< (car ipt) (car pt))
							(< (distance ipt pt)(distance pl pt))
						)
						(setq pl ipt)
					)
					(
						(and 
							(and pr)
							(> (car ipt) (car pt))
							(< (distance ipt pt)(distance pr pt))
						)
						(setq pr ipt)
					)
				)
			)
			(setq int_pts nil)
		)
		(cond 
			((and pl pr)
				(command "_.dimhorizontal" pl pr pr)
			)
		)
		(setq pl nil pr nil)
		;-----------
		(setq i -1 pu nil pb nil)
		(while (< (setq i (1+ i)) (length enameList))
			(setq eo (vlax-ename->vla-object (nth i enameList)))
			(setq int_pts (get_intersection_points line_ver_obj eo))
			(foreach ipt int_pts
				(cond 
					((and (not pb)(< (cadr ipt) (cadr pt)))
						(setq pb ipt)
					)
					((and (not pu)(> (cadr ipt) (cadr pt)))
						(setq pu ipt)
					)
					(
						(and 
							(and pb)
							(< (cadr ipt) (cadr pt))
							(< (distance ipt pt)(distance pb pt))
						)
						(setq pb ipt)
					)
					(
						(and 
							(and pu)
							(> (cadr ipt) (cadr pt))
							(< (distance ipt pt)(distance pu pt))
						)
						(setq pu ipt)
					)
				)
			)
			(setq int_pts nil)
		)
		(cond 
			((and pb pu)
				(command "_.dimvertical" pb pu pu)
			)
		)
		(setq pu nil pb nil)
		(vlax-release-object line_hor_obj)
		(vlax-release-object line_ver_obj)	
	    (entdel line_hor)
		(entdel line_ver)
	)
	(setvar 'cmdecho 1)
(princ)
)

[larsr2866]

Wow thanks! That works like a charm.

The solution of Kent Cooper also did the job, but the 2th lisp from hak_vz works really fast!

It's exactly what i was looking for. You guys are awesome! 🙂

[hak_vz]

@larsr2866 

Check this line and add ore remove comma delimited entity types that you need.

(setq ss (ssget "_X" '((0 . "LWPOLYLINE,LINE,CIRCLE,ELLIPSE"))))

Dimensions are not entity associated since they are created between nearest points to your pick point.

Code is not thoroughly tested so if you notice some problems changes are possible.

Glad to be of help.

[larsr2866]

Maybe one question. I've noticed that the dimensions are also snapped to the nearest 'freezed layer' objects.

Is it possible to only snap to the visible layers? 

[hak_vz · Accepted solution]

---

@larsr2866 wrote:

Maybe one question. I've noticed that the dimensions are also snapped to the nearest 'freezed layer' objects.

Is it possible to only snap to the visible layers? 

---

Change this line

(setq ss (ssget "_X" '((0 . "LWPOLYLINE,LINE,CIRCLE,ELLIPSE"))))

to

(setq ss (ssget '((0 . "LWPOLYLINE,LINE,CIRCLE,ELLIPSE"))))

 You will have to select all entities you want to include in dimension creation i.e. select all visible objects with window selection.

[ВeekeeCZ]

Or perhaps  "_A" instead of "_X"? That will exclude all objects in frozen layers.

[larsr2866]

Perfect! Thanks!

[larsr2866]

I hardly dare to ask because the first lisp already works well, but i have been testing today and was wondering if this could also be possible with continued dimensions? 

It would really help me, if i click on a position, the defun could be able to 'recognize' all lines, plines, objects on this position and create horizontal continuous dimension between them? + the same with the vertical?

I already tried to figure out some stuff in the lisp (1th works best currently, because i can change lines, pline, circles, ..), but it's a bit beyond my knowledge.

Thank you.

[hak_vz]

@larsr2866  I'll try to make this version using previous code.

[Kent1Cooper]

---

@larsr2866 wrote:

I ... was wondering if this could also be possible with continued dimensions? ....

---

Are you aware of the QDIM command?  With crossing-window or fence selection across a string of things, it dimensions the whole series at once:

Depending on the details and object types, it can put in some additional to what you want, but adjusting is easy if and when that happens, and no custom command is needed.

[larsr2866]

Thanks for the reaction. Yes, i know the command QDim, but i've noticed a lot of issues with this. With closed polylines it takes mostly to much grippoints. I also work a lot with special entities (proxy) and the QDim doesn't recognize these entities.

In the first lisp from hak_vz i have changed the entity  (setq ss (ssget "_X" '((0 . "LWPOLYLINE,LINE,CIRCLE,ELLIPSE")))) too the name of the proxy element, and its worked great!

[hak_vz]

@larsr2866  Try this

(defun c:dimhorver_all 
	;author hak_vz  
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;Friday, September 3, 2021 
	(
	/ *error* mappend mklist flatten take pointlist3d sset->enameList get_intersections get_intersection_points
	adoc ss enameList pt line_hor line_hor_obj line_ver line_ver_obj i j ph pv eo int_pts
	)
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(setvar 'cmdecho 1)
		(princ)
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	(defun pointlist3d (lst / ret) (while lst (setq	ret (cons (take 3 lst) ret) lst (cdddr lst))) (reverse ret))
	(defun mappend (fn lst)(apply 'append (mapcar fn lst)))
	(defun mklist (x) (if (listp x) x (list x)))
	(defun flatten (exp)(mappend 'mklist exp))
	(defun sset->enameList (ss / i ret)
		; extracts elements name for all objects in a selection set into a list
		(if ss
			(repeat (setq i (sslength ss))
				(setq ret (cons (ssname ss (setq i (1- i))) ret))
			) ;_ end of repeat
		) ;_ end of if
	) ;_ end of defun
	(defun get_intersections	(obj1 obj2 / var)
		(setq var (vlax-variant-value (vla-intersectwith obj1 obj2 1)))
		(if (< 0 (vlax-safearray-get-u-bound var 1))(vlax-safearray->list var))
	)
	(defun get_intersection_points (obj1 obj2) (pointlist3d (get_intersections obj1 obj2)))
	(setvar 'cmdecho 0)
	(setq ss (ssget '((0 . "LWPOLYLINE,LINE,CIRCLE,ELLIPSE"))))
	(setq enameList (sset->enameList ss))
	(setq ph (getpoint "\nPick a point for horizontal dimensions position >"))
	(setq pv (getpoint "\nPick a point for vertical dimensions position >"))
	(cond 
		((and ph pv)
			(setq pt (list (car pv) (cadr ph)))
			(setq line_ver
				(entmakex
					(list
						(cons 0 "XLINE")
						(cons 100 "AcDbEntity")
						(cons 100 "AcDbXline")
						(cons 10 (trans pt 1 0))
						(cons 11 '(0 1 0))
					)
				)
			)
			(setq line_ver_obj (vlax-ename->vla-object line_ver))
			(setq line_hor
				(entmakex
					(list
						(cons 0 "XLINE")
						(cons 100 "AcDbEntity")
						(cons 100 "AcDbXline")
						(cons 10 (trans pt 1 0))
						(cons 11 '(1 0 0))
					)
				)
			)
			(setq line_hor_obj (vlax-ename->vla-object line_hor))
			(setq i -1)
			(while (< (setq i (1+ i)) (length enameList))
				(setq eo (vlax-ename->vla-object (nth i enameList)))
				(setq ipts (get_intersection_points line_hor_obj eo))
				(if (and ipts) (setq int_pts (cons ipts int_pts)))
			)
			(cond 
				((and int_pts)
					(setq int_pts (vl-sort (flatten int_pts) '(lambda (x y) (< (car x)(car y)))))
					(setq j -1)
					(while (< (setq j (1+ j)) (1- (length int_pts)))
						(command "_.dimhorizontal" (nth j int_pts)(nth (1+ j) int_pts)(nth (1+ j) int_pts))
					)
				)
			)
			(setq int_pts nil)
			
			(setq i -1)
			(while (< (setq i (1+ i)) (length enameList))
				(setq eo (vlax-ename->vla-object (nth i enameList)))
				(setq ipts (get_intersection_points line_ver_obj eo))
				(if (and ipts) (setq int_pts (cons ipts int_pts)))				
			)
			
			(cond 
				((and int_pts)
					(setq int_pts (vl-sort (flatten int_pts) '(lambda (x y) (< (cadr x)(cadr y)))))
					(setq j -1)
					(while (< (setq j (1+ j)) (1- (length int_pts)))
						(command "_.dimvertical" (nth j int_pts)(nth (1+ j) int_pts)(nth (1+ j) int_pts))
					)
				)
			)
			(setq int_pts nil)
			(vlax-release-object eo)
			(vlax-release-object line_hor_obj)
			(vlax-release-object line_ver_obj)	
			(entdel line_hor)
			(entdel line_ver)
		)
	)
	(setvar 'cmdecho 1)
(princ)
)

[larsr2866]

You are unbelievable 🙂 This is a huge help!

Is it possible to seperate the horizontals from the verticals? (as 2 seperate functions)?

[hak_vz]

What about adding switch to either create horizontal, vertical or both dimensions?

[larsr2866]

If that's possible, great! 🙂

[hak_vz · Accepted solution]

Try this. I hope it's OK.

(defun c:dimhorver_all 
	;author hak_vz  
	;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
	;Friday, September 3, 2021 
	(
	/ *error* mappend mklist flatten take pointlist3d sset->enameList get_intersections get_intersection_points
	adoc ss enameList pt line_hor line_hor_obj line_ver line_ver_obj i j ph pv eo int_pts sel
	)
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ)
		)
		(setvar 'cmdecho 1)
		(princ)
	)
	(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
	(defun pointlist3d (lst / ret) (while lst (setq	ret (cons (take 3 lst) ret) lst (cdddr lst))) (reverse ret))
	(defun mappend (fn lst)(apply 'append (mapcar fn lst)))
	(defun mklist (x) (if (listp x) x (list x)))
	(defun flatten (exp)(mappend 'mklist exp))
	(defun sset->enameList (ss / i ret)
		; extracts elements name for all objects in a selection set into a list
		(if ss
			(repeat (setq i (sslength ss))
				(setq ret (cons (ssname ss (setq i (1- i))) ret))
			) ;_ end of repeat
		) ;_ end of if
	) ;_ end of defun
	(defun get_intersections	(obj1 obj2 / var)
		(setq var (vlax-variant-value (vla-intersectwith obj1 obj2 1)))
		(if (< 0 (vlax-safearray-get-u-bound var 1))(vlax-safearray->list var))
	)
	(defun get_intersection_points (obj1 obj2) (pointlist3d (get_intersections obj1 obj2)))
	(setvar 'cmdecho 0)
	(setq ss (ssget '((0 . "LWPOLYLINE,LINE,CIRCLE,ELLIPSE"))))
	(setq enameList (sset->enameList ss))
	(initget 1 "H V B")
	(setq sel (getkword "\nDraw Horizontal, Vertical or Both dimensions <H V B> ?"))
	(cond 
		((= sel "H")
			(setq pt (getpoint "\nPick a point for horizontal dimensions position >"))
		)
		((= sel "V")
			(setq pt (getpoint "\nPick a point for vertical dimensions position >"))
		)
		((= sel "B")
			(setq ph (getpoint "\nPick a point for horizontal dimensions position >"))
			(setq pv (getpoint "\nPick a point for vertical dimensions position >"))
			(setq pt (list (car pv) (cadr ph)))
		)	
	)
	
	(cond 
		((and pt)
			
			(setq line_ver
				(entmakex
					(list
						(cons 0 "XLINE")
						(cons 100 "AcDbEntity")
						(cons 100 "AcDbXline")
						(cons 10 (trans pt 1 0))
						(cons 11 '(0 1 0))
					)
				)
			)
			(setq line_ver_obj (vlax-ename->vla-object line_ver))
			(setq line_hor
				(entmakex
					(list
						(cons 0 "XLINE")
						(cons 100 "AcDbEntity")
						(cons 100 "AcDbXline")
						(cons 10 (trans pt 1 0))
						(cons 11 '(1 0 0))
					)
				)
			)
			(cond 
				((or (= sel "H")(= sel "B"))
					(setq line_hor_obj (vlax-ename->vla-object line_hor))
					(setq i -1)
					(while (< (setq i (1+ i)) (length enameList))
						(setq eo (vlax-ename->vla-object (nth i enameList)))
						(setq ipts (get_intersection_points line_hor_obj eo))
						(if (and ipts) (setq int_pts (cons ipts int_pts)))
					)
					(cond 
						((and int_pts)
							(setq int_pts (vl-sort (flatten int_pts) '(lambda (x y) (< (car x)(car y)))))
							(setq j -1)
							(while (< (setq j (1+ j)) (1- (length int_pts)))
								(command "_.dimhorizontal" (nth j int_pts)(nth (1+ j) int_pts)(nth (1+ j) int_pts))
							)
						)
					)
					(setq int_pts nil)
				)
			)
			(cond 
				((or (= sel "V")(= sel "B"))
					(setq i -1)
					(while (< (setq i (1+ i)) (length enameList))
						(setq eo (vlax-ename->vla-object (nth i enameList)))
						(setq ipts (get_intersection_points line_ver_obj eo))
						(if (and ipts) (setq int_pts (cons ipts int_pts)))				
					)
					
					(cond 
						((and int_pts)
							(setq int_pts (vl-sort (flatten int_pts) '(lambda (x y) (< (cadr x)(cadr y)))))
							(setq j -1)
							(while (< (setq j (1+ j)) (1- (length int_pts)))
								(command "_.dimvertical" (nth j int_pts)(nth (1+ j) int_pts)(nth (1+ j) int_pts))
							)
						)
					)
					(setq int_pts nil)
				)
			)
			(if (and eo)(vlax-release-object eo))
			(if (and line_hor_obj)(vlax-release-object line_hor_obj))
			(if (and line_ver_obj)(vlax-release-object line_ver_obj))	
			(entdel line_hor)
			(entdel line_ver)
		)
	)
	(setvar 'cmdecho 1)
(princ)
)

[larsr2866]

It works! Thanks again! 🙂

You've been a great help!