@larsr2866 wrote:
I was just wondering if it could be possible to stay in the same command after selecting the objects and choosing the appropriate direction? So for example I can first put all the horizontal dimensions (on the different positions), without selecting the same objects and choose horizontally every time?
Here you have modified code that works this way.
(defun c:dimhorver_all
;author hak_vz
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;Tuesday, September 7, 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 k ph pv eo int_pts sel old_dim_assoc
)
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ)
)
(if (and adoc) (vla-endundomark adoc))
(setvar 'cmdecho 1)
(setvar 'DIMASSOC old_dim_assoc)
(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)))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(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> ?"))
(setq old_dim_assoc (getvar 'DIMASSOC))
(setvar 'DIMASSOC 1)
(setvar 'cmdecho 0)
(setq k 1)
(while
(and
(cond
((= sel "H")
(setq pt (getpoint (strcat "\nPick " (itoa k)". point for horizontal dimensions position >")))
)
((= sel "V")
(setq pt (getpoint (strcat "\nPick " (itoa k)". point for vertical dimensions position >")))
)
((= sel "B")
(setq ph (getpoint (strcat "\nPick " (itoa k)". point for horizontal dimensions position >")))
(setq pv (getpoint (strcat "\nPick " (itoa k)". point for vertical dimensions position >")))
(setq pt (list (car pv) (cadr ph)))
)
)
)
(vla-endundomark adoc)
(vla-startundomark adoc)
(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)
(vla-endundomark adoc)
(setq k (1+ k))
)
(setvar 'cmdecho 1)
(setvar 'DIMASSOC old_dim_assoc)
(princ "\nDone!")
(princ)
)
Miljenko Hatlak
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
