Does anyone know how to get a vertex on a 3d polyline at intersection lines. I found this but it refers to a regular polyline. Thanks
This is the code (by marko_ribar) that refers to the polyline:
;;; plintav1 - adds vertices at intersection of pline and selection set of curves ;;;
(defun c:plintav1 ( / intersobj1obj2 LM:Unique AT:GetVertices member-fuzz add_vtx
s1 ss ent n entx intpts intptsall plpts par f )
(vl-load-com)
(defun intersobj1obj2 ( obj1 obj2 / coords pt ptlst )
(if (eq (type obj1) 'ENAME) (setq obj1 (vlax-ename->vla-object obj1)))
(if (eq (type obj2) 'ENAME) (setq obj2 (vlax-ename->vla-object obj2)))
(setq coords (vl-catch-all-apply 'vlax-safearray->list (list (vl-catch-all-apply 'vlax-variant-value (list (vla-intersectwith obj1 obj2 AcExtendNone))))))
(if (vl-catch-all-error-p coords)
(setq ptlst nil)
(repeat (/ (length coords) 3)
(setq pt (list (car coords) (cadr coords) (caddr coords)))
(setq ptlst (cons pt ptlst))
(setq coords (cdddr coords))
)
)
ptlst
)
(defun LM:Unique ( lst )
(if lst (cons (car lst) (LM:Unique (vl-remove (car lst) (cdr lst)))))
)
(defun AT:GetVertices ( e / p l )
(LM:Unique
(if e
(if (eq (setq p (vlax-curve-getEndParam e)) (fix p))
(repeat (setq p (1+ (fix p)))
(setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
)
(list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
)
)
)
)
(defun member-fuzz ( expr lst fuzz )
(while (and lst (not (equal (car lst) expr fuzz)))
(setq lst (cdr lst))
)
lst
)
(defun add_vtx ( obj add_pt ent_name / bulg sw ew )
(vla-GetWidth obj (fix add_pt) 'sw 'ew)
(vla-addVertex
obj
(1+ (fix add_pt))
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 1))
(list
(car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
(cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
)
)
)
)
(setq bulg (vla-GetBulge obj (fix add_pt)))
(vla-SetBulge obj
(fix add_pt)
(/
(sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
(cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
)
)
(vla-SetBulge obj
(1+ (fix add_pt))
(/
(sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
(cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
)
)
(vla-SetWidth obj (fix add_pt) sw (+ sw (* (- ew sw) (- add_pt (fix add_pt)))))
(vla-SetWidth obj (1+ (fix add_pt)) (+ sw (* (- ew sw) (- add_pt (fix add_pt)))) ew)
(vla-update obj)
)
(prompt "\nPick source POLYLINE...")
(setq s1 (ssget "_+.:E:S:L" (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 128) '(70 . 129) '(-4 . "or>") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
(while (not s1)
(prompt "\nMissed... Try picking source POLYLINE on unlocked layer again...")
(setq s1 (ssget "_+.:E:S:L" (list '(0 . "*POLYLINE") '(-4 . "<or") '(70 . 0) '(70 . 1) '(70 . 128) '(70 . 129) '(-4 . "or>") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
)
(prompt "\nNow select intersecting curves...")
(setq ss (ssget (list '(0 . "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XRAY") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
(while (not ss)
(prompt "\nEmpty sel.set... Please reselect intersecting curves again...")
(setq ss (ssget (list '(0 . "*POLYLINE,SPLINE,LINE,ARC,CIRCLE,ELLIPSE,HELIX,RAY,XRAY") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model")))))
)
(setq ent (ssname s1 0))
(if (= (cdr (assoc 0 (entget ent))) "POLYLINE")
(progn
(command "_.CONVERTPOLY" "_L" ent "")
(entupd (setq ent (entlast)))
(vla-update (vlax-ename->vla-object ent))
(setq f t)
)
)
(repeat (setq n (sslength ss))
(setq entx (ssname ss (setq n (1- n))))
(setq intpts (intersobj1obj2 ent entx))
(setq intptsall (append intpts intptsall))
)
(foreach intpt intptsall
(setq plpts (AT:GetVertices ent))
(if
(and
(not (member-fuzz intpt plpts 1e-6))
(setq par (vlax-curve-getparamatpoint ent (vlax-curve-getclosestpointto ent intpt)))
)
(add_vtx (vlax-ename->vla-object ent) par ent)
)
)
(if f
(progn
(command "_.CONVERTPOLY" "_H" ent "")
(entupd (setq ent (entlast)))
(vla-update (vlax-ename->vla-object ent))
)
)
(princ)
)
