hi there,
check this one. need to select source entities, alignment source points 1, 2 and target entity.
;*************************************************************************************************************************************
; komondormrex, nov 2023
;*************************************************************************************************************************************
(defun vector_multiplying (vector_1 vector_2 / x1 y1 z1 x2 y2 z2)
(mapcar 'set '(x1 y1 z1) vector_1)
(mapcar 'set '(x2 y2 z2) vector_2)
(if (minusp (caddr (list (- (* y1 z2) (* z1 y2))
(- (* z1 x2) (* x1 z2))
(- (* x1 y2) (* y1 x2))
)
)
) -1 +1
)
)
;*************************************************************************************************************************************
(defun pick_entity (_prompt group_0_list start_end_list get_segment closed_allowed / entsel_data target_entity)
(while (and
(if (vl-catch-all-error-p (setq entsel_data (vl-catch-all-apply 'entsel (list (strcat "\n" _prompt ": ")))))
(setq target_entity nil)
t
)
(if entsel_data (setq target_entity (car entsel_data)) t)
(if (member (cdr (assoc 0 (entget target_entity))) group_0_list)
(if (= "LWPOLYLINE" (cdr (assoc 0 (entget target_entity))))
(if closed_allowed
nil
(minusp (vlax-get (vlax-ename->vla-object target_entity) 'closed))
)
nil
)
t
)
)
)
(if target_entity
(cond
(
(and
(= "LWPOLYLINE" (cdr (assoc 0 (entget target_entity))))
get_segment
)
(setq picked_param (fix (vlax-curve-getparamatpoint
target_entity
(vlax-curve-getclosestpointto target_entity (cadr entsel_data))
)
)
)
(set start_end_list (list (vlax-curve-getpointatparam target_entity picked_param)
(vlax-curve-getpointatparam target_entity (1+ picked_param))
)
)
target_entity
)
(
t
(set start_end_list (list (vlax-curve-getstartpoint target_entity)
(vlax-curve-getendpoint target_entity)
)
)
target_entity
)
)
)
)
;*************************************************************************************************************************************
(defun c:smart_align (/ source_entity_list source_points target_points alpha cos_alpha rotation_point sin_alpha
target_entity vector_1 vector_2
)
(prompt "\nSelect source arc or lwplines entities...")
(setq source_entity_list (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "arc,lwpolyline"))))))
source_points (list (setq 1st_point (getpoint "\nPick source 1st alignment point: "))
(getpoint 1st_point "\nPick source 2nd alignment point: ")
)
target_entity (pick_entity "Pick target entity" '("LINE" "LWPOLYLINE") 'target_points t t)
)
(setq rotation_point (inters (car target_points) (cadr target_points) (car source_points) (cadr source_points) nil))
(if rotation_point
(progn
(setq vector_1 (mapcar '- (cadr source_points) (car source_points))
vector_2 (mapcar '- (cadr target_points) (car target_points))
cos_alpha (/ (apply '+ (mapcar '* vector_1 vector_2))
(* (sqrt (apply '+ (mapcar 'expt vector_1 '(2 2))))
(sqrt (apply '+ (mapcar 'expt vector_2 '(2 2))))
)
)
)
(cond
((equal 0 cos_alpha 1e-8) (setq alpha (* 0.5 pi)))
((equal 1.0 cos_alpha 1e-8) (setq alpha 0))
(t (setq sin_alpha (sqrt (- 1 (expt cos_alpha 2)))
alpha (atan (/ sin_alpha cos_alpha))
)
)
)
)
)
(foreach source_entity source_entity_list
(if rotation_point
(vla-rotate (vlax-ename->vla-object source_entity)
(vlax-3d-point (mapcar '* '(0.5 0.5) (mapcar '+ (car source_points) (cadr source_points))))
(* alpha (vector_multiplying vector_1 vector_2))
)
)
(vla-scaleentity (vlax-ename->vla-object source_entity)
(vlax-3d-point (mapcar '* '(0.5 0.5) (mapcar '+ (car source_points) (cadr source_points))))
(/ (apply 'distance target_points) (apply 'distance source_points))
)
(vla-move (vlax-ename->vla-object source_entity)
(vlax-3d-point (mapcar '* '(0.5 0.5) (mapcar '+ (car source_points) (cadr source_points))))
(vlax-3d-point (mapcar '* '(0.5 0.5) (mapcar '+ (car target_points) (cadr target_points))))
)
(vla-mirror (vlax-ename->vla-object source_entity)
(vlax-3d-point (car target_points))
(vlax-3d-point (cadr target_points))
)
(entdel source_entity)
)
(princ)
)
;*************************************************************************************************************************************
updated_2
