Le portail francophone de la géomatique

(vl-load-com)
(defun c:OD2Label_Side ( / js obj ename htx AcDoc Space nw_style lst_tabl_def lst_def desc_od str pt deriv rtx  nw_obj)
    (princ "\nSélectionnez une polyligne.")
    (while
        (null
            (setq js
                (ssget "_+.:E:S"
                    (list
                        '(0 . "LWPOLYLINE")
                        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
                        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
                    )
                )
            )
        )
        (princ "\nCe n'est pas un objet valable pour cette fonction!")
    )
    (setq
        obj (ssname js 0)
        ename (vlax-ename->vla-object obj)
    )
    (cond
        ((ade_odgettables obj)
            (initget 6)
            (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: ")))
            (if htx (setvar "TEXTSIZE" htx))
            (setq
                AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
                Space
                (if (= 1 (getvar "CVPORT"))
                    (vla-get-PaperSpace AcDoc)
                    (vla-get-ModelSpace AcDoc)
                )
            )
            (cond
                ((null (tblsearch "LAYER" "Label"))
                    (vlax-put (vla-add (vla-get-layers AcDoc) "Label") 'color 96)
                )
            )
            (cond
                ((null (tblsearch "STYLE" "Romand-Label"))
                    (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Label"))
                    (mapcar
                        '(lambda (pr val)
                            (vlax-put nw_style pr val)
                        )
                        (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
                        (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0)
                    )
                )
            )
            (setq lst_tabl_def (mapcar 'ade_odtabledefn (ade_odgettables obj)))
            (foreach n lst_tabl_def
                (foreach el n
                    (if (listp (cdr el))
                        (foreach sel (cdr el)
                            (foreach msel sel
                                (if (eq (car msel) "ColName")
                                    (setq lst_def (cons (strcase (cdr msel)) lst_def))
                                )
                            )
                        )
                    )
                )
            )
            (print lst_def)
            (while (not (member (setq desc_od (strcase (getstring T "\nDescription de la donnée d'objet: "))) lst_def))
                (princ "\nCette description n'est pas présente dans la table")
            )
            (setq str (ade_odgetfield obj (car(ade_odgettables obj)) desc_od 0))
            (while (setq pt (getpoint "\nPoint?: "))
                (setq
                    pt (vlax-curve-getClosestPointTo ename    (trans pt 1 0))
                    deriv (vlax-curve-getFirstDeriv ename (vlax-curve-GetParamAtPoint ename pt))
                    rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
                )
                (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
                (setq nw_obj
                    (vla-addMtext Space
                        (vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE"))))
                        0.0
                        str
                    )
                )
                (mapcar
                    '(lambda (pr val)
                        (vlax-put nw_obj pr val)
                    )
                    (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
                    (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Label" "Label" rtx)
                )
            )
        )
        (T (princ "\nPas de données d'objet attachées"))
    )
    (prin1)
)