(defun c:con (/ *error* obj ins a0 ent par ang)

(vl-load-com)

(defun *error* (msg)

(if (= msg "Fonction annul?e")

(princ)

(princ (strcat "Erreur: " msg))

)

(vla-EndUndoMark *acdoc*)

(princ)

)

(and

(setq obj (car (entsel)))

(setq obj (vlax-ename->vla-object obj))

(member (vla-get-ObjectName obj)

'("AcDbBlockReference" "AcDbText" "AcDbMText")

)

(or

(and

(setq ins (getpoint "\nBase Point [b]: "))

(setq ins (vlax-3d-point (trans ins 1 0)))

)

(setq ins (vla-get-InsertionPoint obj))

)

(setq a0 (vla-get-Rotation obj))

(while (and

(setq ent (entsel "\nSelect line for align to: "))

(setq pt (osnap (cadr ent) "_nea"))

(not (vl-catch-all-error-p

(setq par

(vl-catch-all-apply

'vlax-curve-getParamAtPoint

(list (setq ent (car ent)) (setq pt (trans pt 1 0)))

)

)

)

)

)

(vla-StartUndoMark

(vla-get-ActiveDocument (vlax-get-acad-object))

)

(setq ang (angle '(0 0 0) (vlax-curve-getFirstDeriv ent par)))

(if (minusp (cos ang))

(setq ang (- (+ ang pi) a0))

(setq ang (- ang a0))

)

(setq cop (vla-copy obj))

(vla-Move cop ins (vlax-3d-point pt))

(vla-Rotate cop (vlax-3d-point pt) ang)

(vla-EndUndoMark

(vla-get-ActiveDocument (vlax-get-acad-object))

)

)

)

(princ)

)
(c:con)

Advertisements