;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
(defun sublist (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(repeat leng
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)
;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))
(defun split-list (lst n)
(if lst
(cons (sublist lst 0 n)
(split-list (sublist lst n nil) n)
)
)
)
(defun c:foo (/ z ent)
(while (= z nil)
(if (setq ent (entsel "\nSelect Polyline" ))
(if (or (= "POLYLINE" (cdr (assoc 0 (entget (car ent)))))
(= "LWPOLYLINE" (cdr (assoc 0 (entget (car ent)))))
)
(progn
(setq z 0)
(setq coordList (split-list (vlax-get (vlax-ename->vla-object (car ent)) 'Coordinates) 3))
)
(princ "\n No Polyline selected")
)
(setq z nil)
)
)
(setq z nil)
(princ)
)
(defun checkSegments ( p1 p2 p3)
(if (equal (angle p1 p2) (angle p2 p3) (* pi (/ 10 180)))
(setq lista (append (list lista) (list p1) (list p2) (list p3)))
(setq lista (append (list lista) (list p1) (list p2)))
)
)
(defun c:test ()
(while (/= coordList nil)
(checkSegments
(car coordList)
(cadr coordList)
(caddr coordList)
)
(setq coordList (cdr coordList))(setq coordList (cdr coordList))(setq coordList (cdr coordList))
)
)
(defun checkSegments ( p1 p2 p3)
(if (equal (angle p1 p2) (angle p2 p3) (* pi (/ 10 180)))
(setq lista (append lista (list p1) (list p2) (list p3)))
(setq lista (append lista (list p1) (list p2)))
)
(setq mspace (vla-get-ModelSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
(vlax-invoke mspace 'Add3dPoly (apply 'append (reverse lista)))
(princ)
)
(setq fuzzang (getreal (strcat "\nInput fuzz tolerance angle in decimal degrees for recreating new 3d polyines of reference 3d polyline vertices: " (rtos (* (/ 180 pi) (angle (car ptlst) (cadr ptlst))) 2 (getvar "AUPREC")))))
Marko, can you explain, what did it do your code. You collect all vertex and than your working with a toleranz angle from what. Is it the angle between seg1 to seg2 and seg2 to seg3 and seg3 to seg 4 ... ?
My example in last drawing didnīt work if I typed 1, 5, 10 or 15 degrees
(defun c:reconst3dpoly (/ 3dpl fuzzang fuzzangr initang pt ptlst pt1lst pt2lst ptlst1 ptlst11 ptlst2 ss tst tt vert)
(prompt "\nPick zig-zag reference 3d polyline")
(while (not ss)
(setq ss (ssget "_+.:E:S:L" (list '(0 . "POLYLINE") '(70 . 8))))
(if (not ss) (prompt "\nMissed, try again"))
)
(setq 3dpl (ssname ss 0))
(setq vert 3dpl)
(while (and (setq vert (entnext vert)) (eq (cdr (assoc 0 (entget vert))) "VERTEX"))
(setq pt (cdr (assoc 10 (entget vert))))
(setq ptlst (cons pt ptlst))
)
(setq ptlst (reverse ptlst))
(initget 7)
(setq fuzzang (getreal "\nInput fuzz tolerance angle in decimal degrees for recreating new 3d polyines of reference 3d polyline vertices: "))
(setq fuzzangr (* (/ fuzzang 180.0) pi))
(setq initang (angle (car ptlst) (cadr ptlst)))
(setq pt2lst ptlst)
(foreach pt1 ptlst
(setq pt1lst (cons pt1 pt1lst))
(foreach pt pt1lst (setq pt2lst (vl-remove pt pt2lst)))
(if (and ptlst1 (equal pt1 (car ptlst1) 1e-6)) (setq tt nil))
(foreach pt2 pt2lst
(if (and (not tt)
(equal (setq diffan (angle pt1 pt2)) initang fuzzangr))
(progn
(setq diffan (/ (* 180 (- diffan initang)) pi))
(setq initang (angle pt1 pt2))
(setq ptlst1 (cons pt1 ptlst1)
ptlst1 (cons pt2 ptlst1)
tt t
)
(entmake (list '(0 . "TEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbText")
(cons 10 (trans pt1 1 0))
(cons 8 (getvar "CLAYER"))
(cons 7 "SIMPLEX8"); Textstyle
(cons 62 3) ; TextColor
(cons 40 (getvar "TEXTSIZE")); Textsize
(cons 41 0.8) ; TextWidth
(cons 50 0) ; TextAngle
(cons 1 (rtos diffan 2 (getvar "AUPREC"))) ; Textmessage
)
)
)
)
)
)
(setq ptlst1 (reverse ptlst1))
(setq ptlst1 (acet-list-remove-duplicates ptlst1 1e-6))
(setq initang (angle (car ptlst1) (cadr ptlst1)))
(setq tst (mapcar '(lambda (a b) (if (equal (angle a b) initang fuzzangr) (progn (setq initang (angle a b)) T) nil)) ptlst1 (cdr ptlst1)))
(while (eq (car tst) T)
(setq ptlst11 (cons (car ptlst1) ptlst11))
(setq ptlst1 (cdr ptlst1) tst (cdr tst))
)
(setq ptlst11 (cons (car ptlst1) ptlst11))
(setq ptlst1 ptlst11)
(setq ptlst2 ptlst)
(foreach pt ptlst1
(setq ptlst2 (vl-remove pt ptlst2))
)
(entmake
(list
'(0 . "POLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDb3dPolyline")
'(66 . 1)
'(62 . 1)
'(10 0.0 0.0 0.0)
'(70 . 8)
'(210 0.0 0.0 1.0)
)
)
(foreach pt ptlst1
(entmake
(list
'(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbVertex")
'(100 . "AcDb3dPolylineVertex")
(cons 10 pt)
'(70 . 32)
)
)
)
(entmake
(list
'(0 . "SEQEND")
'(100 . "AcDbEntity")
)
)
(entmake
(list
'(0 . "POLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDb3dPolyline")
'(66 . 1)
'(62 . 1)
'(10 0.0 0.0 0.0)
'(70 . 8)
'(210 0.0 0.0 1.0)
)
)
(foreach pt ptlst2
(entmake
(list
'(0 . "VERTEX")
'(100 . "AcDbEntity")
'(100 . "AcDbVertex")
'(100 . "AcDb3dPolylineVertex")
(cons 10 pt)
'(70 . 32)
)
)
)
(entmake
(list
'(0 . "SEQEND")
'(100 . "AcDbEntity")
)
)
(princ)
)