Hello, i don't know what you want to make! but the original code is it:
Code:
(vl-load-com)
(defun c:epure-masque_lateral ( / js ldat vlaobj perim_obj pt_start pt_end d_x lst_pt pt_last inc vref rad pt pt_int e_last env_mask)
(princ (strcat"\nSélectionner l'objet représentant le bord de la bande de rive de la chaussée."))
(while
(not
(setq js
(ssget "_+.:E:S"
(list
(cons 0 "*POLYLINE,ARC,SPLINE")
(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
(cons -4 "<NOT")
(cons -4 "&") (cons 70 113) ;(70 . 121)
(cons -4 "NOT>")
)
)
)
)
)
(setq
ldat '((20 . 15.5)(30 . 26.5)(40 . 40.0)(50 . 55.0)(60 . 72.0)(70 . 95.0)(80 . 121.0)(90 . 151.0)(100 . 187.0))
vlaobj (vlax-ename->vla-object (ssname js 0))
perim_obj (vlax-curve-getDistAtParam vlaobj (vlax-curve-getEndParam vlaobj))
pt_start (vlax-curve-getStartPoint vlaobj)
pt_end (vlax-curve-getEndPoint vlaobj)
d_x 0.0
lst_pt nil
pt_last nil
env_mask (list pt_end)
inc perim_obj
)
(initget "20 30 40 50 60 70 80 90 100")
(setq vref (getkword "\nVitesse de référence en Km/h de la voie? [20/30/40/50/60/70/80/90/100]<90>: "))
(if (not vref) (setq vref "90"))
(setq rad (cdr (assoc (read vref) ldat)))
(if (>= rad perim_obj) (progn (princ "\nLa distance de visibilité excède la longueur de la bande de rive sélectionnée!") (exit)))
(while (>= inc perim_obj)
(initget 6)
(setq inc (getdist (strcat "\nEquidistance de résolution? <" (rtos (/ rad 10.0)) ">: ")))
(if (not inc) (setq inc (/ rad 10.0)))
(if (>= inc perim_obj) (princ "\nLa distance de résolution de l'épure excède la longueur de la bande de rive sélectionnée!"))
)
(while (< d_x perim_obj)
(setq
lst_pt (cons (vlax-curve-getPointAtDist vlaobj d_x) lst_pt)
d_x (+ d_x inc)
)
)
(while lst_pt
(entmake
(append
'(
(0 . "CIRCLE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "degagement-visibilite-lateral")
(60 . 1)
(62 . 256)
(6 . "ByLayer")
(370 . -2)
(100 . "AcDbCircle")
)
(list (cons 40 rad))
(list (cons 10 (car lst_pt)))
'((210 0.0 0.0 1.0))
)
)
(setq pt (vlax-invoke vlaobj 'IntersectWith (vlax-ename->vla-object (entlast)) acExtendNone))
(if (and pt pt_last (> (length pt) 3))
(if (> (distance (list (car pt) (cadr pt) (caddr pt)) pt_last) (distance (list (cadddr pt) (car (cddddr pt)) (last pt)) pt_last))
(setq pt (list (cadddr pt) (car (cddddr pt)) (last pt)))
(setq pt (list (car pt) (cadr pt) (caddr pt)))
)
)
(entdel (entlast))
(if (and pt (<(length pt) 4))
(progn
(entmake
(append
'(
(0 . "LINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "degagement-visibilite-lateral")
(62 . 9)
(6 . "ByLayer")
(370 . -2)
(100 . "AcDbLine")
)
(list (cons 10 (car lst_pt)))
(list (cons 11 pt))
'((210 0.0 0.0 1.0))
)
)
(if e_last
(progn
(setq pt_int (vlax-invoke (vlax-ename->vla-object e_last) 'IntersectWith (vlax-ename->vla-object (entlast)) acExtendNone))
(if pt_int (setq env_mask (cons pt_int env_mask)))
)
)
(setq e_last (entlast))
)
(setq pt nil)
)
(setq lst_pt (cdr lst_pt) pt_last pt)
)
(setq env_mask (mapcar '(lambda (x) (list 10 (car x) (cadr x))) (reverse (cons pt_start env_mask))))
(entmake
(append
'(
(0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "degagement-visibilite-lateral")
(62 . 3)
(6 . "ByLayer")
(370 . -2)
(100 . "AcDbPolyline")
)
(list (cons 90 (length env_mask)))
'((70 . 0))
(apply 'append (mapcar '(lambda (x10) (append (list x10 '(40 . 0.0) '(41 . 0.0) '(42 . 0.0)))) env_mask))
'((210 0.0 0.0 1.0))
)
)
(prin1)
)
code in french publied here
LISP : Fixed Length Line between 2 Polylines at Fixed offsets
Reply With Quote
Originally Posted by peter
