Author Topic: 2dPolyline to 3dPolyline with arcs (Read 1206 times)

MORITZK · « **on:** July 21, 2015, 04:01:14 PM »

Hallo,
is it possible to convert a LwPolyline to 3dPolyline with Arcs or another curves?
1. convert LW- Polyline to 3D- Polyline without bulges (no problem)
2. convert the bulges to Arcs with ucs. But how can i calculate the 3 axes?
3. join the straight sectors with the arcs to ....? 3d- Polylines are without curves.
The alternative is a 3dPolyline with many short sectors, but this is not the best solution.
Thank you
Moritz

ChrisCarlson · « **Reply #1 on:** July 21, 2015, 04:09:08 PM »

Code - Auto/Visual Lisp: [Select]

;;; 3dPolyFillet -Gilles Chanteau- 21/01/07 -Version 1.5-
;;; "Fillets" a 3D polyline (succession of segments)
 
(defun c:3dPolyFillet (/           3dPolyFillet_err        closest_vertices
                       MakeFillet  AcDoc       ModSp       cnt
                       prec        rad         ent1        ent2
                       vxlst       plst        param       obj
                      )
  (vl-load-com)
 
;;;*************************************************************;;;
 
  (defun 3dPolyFillet_err (msg)
    (if (= msg "Fonction annulée")
      (princ)
      (princ (strcat "\nErreur: " msg))
    )
    (vla-EndUndoMark AcDoc)
    (setq *error* m:err
          m:err nil
    )
    (princ)
  )
 
;;;*************************************************************;;;
 
  (defun closest_vertices (obj pt / par)
    (if (setq par (vlax-curve-getParamAtPoint obj pt))
      (list (vlax-curve-getPointAtParam obj (fix par))
            (vlax-curve-getPointAtParam obj (1+ (fix par)))
      )
    )
  )
 
;;;*************************************************************;;;
 
  (defun MakeFillet (obj   par1  par2  /     pts1  pts2  som   p1    p2
                     ptlst norm  pt0   pt1   pt2   pt3   pt4   cen   ang
                     inc   n     vlst  nb1   nb2
                    )
    (if (and
          (setq pts1 (closest_vertices obj par1))
          (setq pts2 (closest_vertices obj par2))
        )
      (progn
        (setq som (inters (car pts1) (cadr pts1) (car pts2) (cadr pts2) nil))
        (if som
          (if
            (or (equal (car pts1) som 1e-9)
                (equal (cadr pts1) som 1e-9)
                (and
                  (< (vlax-curve-getParamAtPoint obj (car pts1))
                     (vlax-curve-getParamAtPoint obj (car pts2))
                  )
                  (equal (vec1 (car pts1) (cadr pts1))
                         (vec1 (car pts1) som)
                         1e-9
                  )
                )
                (and
                  (< (vlax-curve-getParamAtPoint obj (car pts2))
                     (vlax-curve-getParamAtPoint obj (car pts1))
                  )
                  (equal (vec1 (cadr pts1) (car pts1))
                         (vec1 (cadr pts1) som)
                         1e-9
                  )
                )
            )
             (progn
               (if (< (distance som (car pts1)) (distance som (cadr pts1)))
                 (setq p1 (cadr pts1)
                       p2 (car pts2)
                 )
                 (setq p1 (car pts1)
                       p2 (cadr pts2)
                 )
               )
               (if (= rad 0)
                 (setq ptlst (list som))
                 (progn
                   (setq norm (norm_3pts som p2 p1)
                         pt0  (trans som 0 norm)
                         pt1  (trans p1 0 norm)
                         pt2  (trans p2 0 norm)
                         cen  (inters
                                (polar pt0 (- (angle pt0 pt1) (/ pi 2)) rad)
                                (polar pt1 (- (angle pt0 pt1) (/ pi 2)) rad)
                                (polar pt0 (+ (angle pt0 pt2) (/ pi 2)) rad)
                                (polar pt2 (+ (angle pt0 pt2) (/ pi 2)) rad)
                                nil
                              )
                         pt3  (polar cen (- (angle pt1 pt0) (/ pi 2)) rad)
                         pt4  (polar cen (+ (angle pt2 pt0) (/ pi 2)) rad)
                         ang  (- (angle cen pt4) (angle cen pt3))
                   )
                   (if
                     (and (inters pt0 pt1 cen pt3 T) (inters pt0 pt2 cen pt4 T))
                      (progn
                        (if (minusp ang)
                          (setq ang (+ (* 2 pi) ang))
                        )
                        (setq inc (/ ang prec)
                              n   0
                        )
                        (repeat (1+ prec)
                          (setq ptlst (cons
                                        (polar cen (- (angle cen pt4) (* inc n)) rad)
                                        ptlst
                                      )
                                n     (1+ n)
                          )
                        )
                        (setq ptlst (mapcar '(lambda (p) (trans p norm 0)) ptlst))
                      )
                   )
                 )
               )
               (setq vlst (3d-coord->pt-lst (vlax-get obj 'Coordinates)))
               (if ptlst
                 (progn
                   (setq nb1 (vl-position p1 vlst)
                         nb2 (vl-position p2 vlst)
                   )
                   (if (= (vla-get-closed obj) :vlax-true)
                     (cond
                       ((and (equal p1 (car vlst))
                             (equal p2 (cadr (reverse vlst)))
                        )
                        (setq
                          vlst
                           (append (sublst vlst 1 (1+ nb2)) (reverse ptlst))
                        )
                       )
                       ((and (equal p1 (cadr (reverse vlst)))
                             (equal p2 (car vlst))
                        )
                        (setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst))
                       )
                       ((and (equal p1 (cadr vlst))
                             (equal p2 (last vlst))
                        )
                        (setq
                          vlst
                           (append (reverse ptlst) (sublst vlst (1+ nb1) nil))
                        )
                       )
                       ((and (equal p1 (last vlst))
                             (equal p2 (cadr vlst))
                        )
                        (setq vlst (append ptlst (sublst vlst (1+ nb2) nil))
                        )
                       )
                       (T
                        (if (< nb1 nb2)
                          (setq vlst (append (sublst vlst 1 (1+ nb1))
                                             ptlst
                                             (sublst vlst (1+ nb2) nil)
                                     )
                          )
                          (setq vlst (append (sublst vlst 1 (1+ nb2))
                                             (reverse ptlst)
                                             (sublst vlst (1+ nb1) nil)
                                     )
                          )
                        )
                       )
                     )
                     (if (equal (car vlst) (last vlst) 1e-9)
                       (cond
                         ((and (equal p1 (cadr vlst))
                               (equal p2 (cadr (reverse vlst)))
                          )
                          (setq vlst (append (sublst vlst 2 nb2)
                                             (reverse ptlst)
                                             (list (cadr vlst))
                                     )
                          )
                         )
                         ((and (equal p1 (cadr (reverse vlst)))
                               (equal p2 (cadr vlst))
                          )
                          (setq vlst (append (sublst vlst 2 nb1)
                                             ptlst
                                             (list (cadr vlst))
                                     )
                          )
                         )
                       )
                       (if (< nb1 nb2)
                         (setq vlst (append (sublst vlst 1 (1+ nb1))
                                            ptlst
                                            (sublst vlst (1+ nb2) nil)
                                    )
                         )
                         (setq vlst (append (sublst vlst 1 (1+ nb2))
                                            (reverse ptlst)
                                            (sublst vlst (1+ nb1) nil)
                                    )
                         )
                       )
                     )
                   )
                   (vlax-put obj 'Coordinates (apply 'append vlst))
                 )
                 (prompt "\nRadius is too large.")
               )
             )
             (prompt "\nDivergent segments.")
          )
          (prompt "\nSegments are not converging.")
        )
      )
      (prompt "\nRadius is too large.")
    )
  )
 
 
 
 
;;;*************************************************************;;;
 
  (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        ModSp (vla-get-ModelSpace AcDoc)
  )
  (setq m:err   *error*
        *error* 3dPolyFillet_err
  )
  (vla-StartUndoMark AcDoc)
 
  ;; Saisie des données
  (if (not (vlax-ldata-get "3dFillet" "Prec"))
    (vlax-ldata-put "3dFillet" "Prec" 20)
  )
  (if (not (vlax-ldata-get "3dFillet" "Rad"))
    (vlax-ldata-put "3dFillet" "Rad" 10.0)
  )
  (prompt (strcat "\nCurrent settings.\tSegments: "
                  (itoa (vlax-ldata-get "3dFillet" "Prec"))
                  "\tRadius: "
                  (rtos (vlax-ldata-get "3dFillet" "Rad"))
          )
  )
  (setq cnt 1)
  (while (= 1 cnt)
    (initget 1 "Segments Radius")
    (setq ent1
           (entsel
             "\nSelect first segment ou [Segments/Radius]: "
           )
    )
    (cond
      ((not ent1)
       (prompt "\nNone selected object.")
      )
      ((= ent1 "Segments")
       (initget 6)
       (if (setq prec
                  (getint
                    (strcat "\nSpecify le number of segments for arcs <"
                            (itoa (vlax-ldata-get "3dFillet" "Prec"))
                            ">: "
                    )
                  )
           )
         (vlax-ldata-put "3dFillet" "Prec" prec)
       )
      )
      ((= ent1 "Radius")
       (initget 4)
       (if (setq rad
                  (getdist
                    (strcat "\nSpecify the radius <"
                            (rtos (vlax-ldata-get "3dFillet" "Rad"))
                            ">: "
                    )
                  )
           )
         (vlax-ldata-put "3dFillet" "Rad" rad)
       )
      )
      ((and
         (= (cdr (assoc 0 (entget (car ent1)))) "POLYLINE")
         (= (logand 8 (cdr (assoc 70 (entget (car ent1))))) 8)
       )
       (setq cnt 0)
      )
      (T
       (prompt "\nSelected object is not a 3D polyline.")
      )
    )
  )
  (setq prec (vlax-ldata-get "3dFillet" "Prec")
        rad  (vlax-ldata-get "3dFillet" "Rad")
  )
  (while (not ent2)
    (initget 1 "All")
    (setq ent2 (entsel "\nSelect second segment or [All]: "))
    (if (not (or (= ent2 "All") (eq (car ent1) (car ent2))))
      (progn
        (prompt
          "\nThe selected segment is not on same object"
        )
        (setq ent2 nil)
      )
    )
  )
  (setq obj (vlax-ename->vla-object (car ent1)))
  (if (= ent2 "All")
    (progn
      (setq vxlst (3d-coord->pt-lst (vlax-get obj 'Coordinates))
            param 0.5
      )
      (repeat (if (= (vla-get-closed obj) :vlax-true) (length vxlst) (1- (length vxlst)))
        (setq plst  (append plst (list (vlax-curve-getPointAtParam obj param)))
              param (1+ param)
        )
      )
      (if (or (= (vla-get-closed obj) :vlax-true)
              (equal (car vxlst) (last vxlst) 1e-9)
              )
        (setq plst (cons (last plst) plst))
        )
      (setq cnt 0)
          (repeat (1- (length plst))
            (MakeFillet obj (nth cnt plst) (nth (setq cnt (1+ cnt)) plst))
          )
    )
    (MakeFillet obj
                (trans (osnap (cadr ent1) "_nea") 1 0)
                (trans (osnap (cadr ent2) "_nea") 1 0)
    )
  )
  (vla-EndUndoMark AcDoc)
  (setq *error* m:err
        m:err nil
  )
  (princ)
)
 
;;;*************************************************************;;;
;;;*********************** SOUS ROUTINES ***********************;;;
 
 
;;; NORM_3PTS returns the normal vector of a 3 points defined plane
 
(defun norm_3pts (org xdir ydir / norm)
  (foreach v '(xdir ydir)
    (set v (mapcar '- (eval v) org))
  )
  (if (inters org xdir org ydir)
    (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm)))
            (setq norm (list (- (* (cadr xdir) (caddr ydir))
                                (* (caddr xdir) (cadr ydir))
                             )
                             (- (* (caddr xdir) (car ydir))
                                (* (car xdir) (caddr ydir))
                             )
                             (- (* (car xdir) (cadr ydir))
                                (* (cadr xdir) (car ydir))
                             )
                       )
            )
    )
  )
)
 
;;;*************************************************************;;;
 
;;; 3d-coord->pt-lst Convert a 3D coordinates flat list in points list
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))
 
(defun 3d-coord->pt-lst (lst)
  (if lst
    (cons (list (car lst) (cadr lst) (caddr lst))
          (3d-coord->pt-lst (cdddr lst))
    )
  )
)
 
;;;*************************************************************;;;
 
;;; SUBLST Returns a sub list
;;; First item : 1
;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4)
;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6)
 
(defun sublst (lst start leng / rslt)
  (if (not (<= 1 leng (- (length lst) start)))
    (setq leng (- (length lst) (1- start)))
  )
  (repeat leng
    (setq rslt  (cons (nth (1- start) lst) rslt)
          start (1+ start)
    )
  )
  (reverse rslt)
)
 
;;;*************************************************************;;;
 
;;; VEC1 Returns the singleunit vector from p1 to p2
 
(defun vec1 (p1 p2)
  (if (not (equal p1 p2 1e-009))
    (mapcar '(lambda (x1 x2)
               (/ (- x2 x1) (distance p1 p2))
             )
            p1
            p2
    )
  )
)
 
;;;*************************************************************;;;
 
;;; BUTLAST List but last item
 
(defun butlast (lst)
  (reverse (cdr (reverse lst)))
)

Will apply a fillet to a 3d polyline, is that what you are trying to do?

Jochen · « **Reply #2 on:** July 22, 2015, 04:20:25 AM »

You could use PEDIT3D from www.ant-ares.de
But please notice: ARCS (and SPLINES and HELICES) are changed into small straigth linear segments.
Regards
Jochen

MORITZK · « **Reply #3 on:** July 22, 2015, 07:48:59 AM »

Hallo, thank you Chris and Jochen.
I see, 3dPolylines with arcs are not possible.
Must convert arc in polyline to short straight linear segemnts and then convert to 3dpolyline.
Thank you for your suggestions.
Moritz

News:

Author Topic: 2dPolyline to 3dPolyline with arcs (Read 1206 times)

MORITZK

2dPolyline to 3dPolyline with arcs

ChrisCarlson

Re: 2dPolyline to 3dPolyline with arcs

Jochen

Re: 2dPolyline to 3dPolyline with arcs

MORITZK

Re: 2dPolyline to 3dPolyline with arcs