Topic: callibrate a 3dPolyline

[cadplayer]

Hello!

I´m wondering if somebody have thought about how I can  modify a 3dPolyline like picture "before" to two 3dPolyline like picture "after".
It coming from surfeyor as he gones sections of a road with same pointCodes. My function draws a 3dPoly after direction of pointNumber. But in this point I need propose improvements.
Anybody a idea how to begin ?

[Lee Mac]

I don't see any images Dirk...

[cadplayer]

oh sorry I forgot it ...
white line shows the direction as Polyline was measured.

[CAB]

Still on my second cup of coffee so maybe I'm not awake yet, but are we looking at a before profile (bottom purple line)
and an after profile (top purple line)?

What pline are you trying to create?

[cadplayer]

No it´s not a profile it´s in plan view I mean the man out measured one 3dPolyline in this form as white line shows. Now I want to convert this Polyline (white) in two Polylines (magenta) so it will be two straight Polylines.
I have a try with select Polyline and compare angle between first and next segment. If the angle is bigger than 10grads third Polylinevertex erased. Can you follow me?

PS.(thanks Gile for your great stringSplitter)

Code: [Select]

;;; (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))
    )
  )


[cadplayer]

Sorry was a error

Code: [Select]

(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)
  )


[cadplayer]

Take a look on this video, maby better than my explanation

[cadplayer]

my idea is to check segment (a) and follow segment (b), if the follow segment(b) goes ca. same angle as segment(a) it should draw a new 3dPolyline otherwise it should stop drawing and check next follow segment(c). Endresult will be a 3dPolyline that goes straight along so I did it in video.

[ribarm]

This worked on my example - see attachment...

Code - Auto/Visual Lisp: [Select]

1. (defun c:reconst3dpoly (/ 3dpl fuzzang fuzzangr initang pt ptlst pt1lst pt2lst ptlst1 ptlst11 ptlst2 ss tst tt vert)
2.   (prompt "\nPick zig-zag reference 3d polyline")
3.   (while (not ss)
4.     (setq ss (ssget "_+.:E:S:L" (list '(0 . "POLYLINE") '(70 . 8))))
5.     (if (not ss) (prompt "\nMissed, try again"))
6.   )
7.   (setq 3dpl (ssname ss 0))
8.   (setq vert 3dpl)
9.   (while (and (setq vert (entnext vert)) (eq (cdr (assoc 0 (entget vert))) "VERTEX"))
10.     (setq pt (cdr (assoc 10 (entget vert))))
11.     (setq ptlst (cons pt ptlst))
12.   )
13.   (setq ptlst (reverse ptlst))
14.   (initget 7)
15.   (setq fuzzang (getreal "\nInput fuzz tolerance angle in decimal degrees for recreating new 3d polyines of reference 3d polyline vertices: "))
16.   (setq fuzzangr (* (/ fuzzang 180.0) pi))
17.   (setq initang (angle (car ptlst) (cadr ptlst)))
18.   (setq pt2lst ptlst)
19.   (foreach pt1 ptlst
20.     (setq pt1lst (cons pt1 pt1lst))
21.     (foreach pt pt1lst (setq pt2lst (vl-remove pt pt2lst)))
22.     (if (and ptlst1 (equal pt1 (car ptlst1) 1e-6)) (setq tt nil))
23.     (foreach pt2 pt2lst
24.       (if (and (not tt) (equal (angle pt1 pt2) initang fuzzangr)) (progn (setq initang (angle pt1 pt2)) (setq ptlst1 (cons pt1 ptlst1) ptlst1 (cons pt2 ptlst1) tt t)))
25.     )
26.   )
27.   (setq ptlst1 (reverse ptlst1))
28.   (setq ptlst1 (acet-list-remove-duplicates ptlst1 1e-6))
29.   (setq initang (angle (car ptlst1) (cadr ptlst1)))
30.   (setq tst (mapcar '(lambda (a b) (if (equal (angle a b) initang fuzzangr) (progn (setq initang (angle a b)) T) nil)) ptlst1 (cdr ptlst1)))
31.   (while (eq (car tst) T)
32.     (setq ptlst11 (cons (car ptlst1) ptlst11))
33.     (setq ptlst1 (cdr ptlst1) tst (cdr tst))
34.   )
35.   (setq ptlst11 (cons (car ptlst1) ptlst11))
36.   (setq ptlst1 ptlst11)
37.   (setq ptlst2 ptlst)
38.   (foreach pt ptlst1
39.     (setq ptlst2 (vl-remove pt ptlst2))
40.   )
41.   (entmake
42.     (list
43.       '(0 . "POLYLINE")
44.       '(100 . "AcDbEntity")
45.       '(100 . "AcDb3dPolyline")
46.       '(66 . 1)
47.       '(62 . 1)
48.       '(10 0.0 0.0 0.0)
49.       '(70 . 8)
50.       '(210 0.0 0.0 1.0)
51.     )
52.   )
53.   (foreach pt ptlst1
54.     (entmake
55.       (list
56.         '(0 . "VERTEX")
57.         '(100 . "AcDbEntity")
58.         '(100 . "AcDbVertex")
59.         '(100 . "AcDb3dPolylineVertex")
60.         (cons 10 pt)
61.         '(70 . 32)
62.       )
63.     )
64.   )
65.   (entmake
66.     (list
67.       '(0 . "SEQEND")
68.       '(100 . "AcDbEntity")
69.     )
70.   )
71.   (entmake
72.     (list
73.       '(0 . "POLYLINE")
74.       '(100 . "AcDbEntity")
75.       '(100 . "AcDb3dPolyline")
76.       '(66 . 1)
77.       '(62 . 1)
78.       '(10 0.0 0.0 0.0)
79.       '(70 . 8)
80.       '(210 0.0 0.0 1.0)
81.     )
82.   )
83.   (foreach pt ptlst2
84.     (entmake
85.       (list
86.         '(0 . "VERTEX")
87.         '(100 . "AcDbEntity")
88.         '(100 . "AcDbVertex")
89.         '(100 . "AcDb3dPolylineVertex")
90.         (cons 10 pt)
91.         '(70 . 32)
92.       )
93.     )
94.   )
95.   (entmake
96.     (list
97.       '(0 . "SEQEND")
98.       '(100 . "AcDbEntity")
99.     )
100.   )
101.   (princ)
102. )
103.  

M.R.

[cadplayer]

Thanks for big effort Marco, I test on your example, but I don´t get it. I don´t realy understand which fuzzy I should typing.

[ribarm]

For my example it's 15-20 degree, but if top projection of imaginary 3d poly connections are close to line the fuzz angle should be smaller...

[cadplayer]

How do I know, which angle I must typing - "try and error" or can I get help. Do you mean angle of first Polylinesegment ?

My try to get angle of segment like this... it´s not helping

Code: [Select]

(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")))))

[ribarm]

Look cadplayer, this angle is tolerance angle, not angle of starting segment... As I said if top projections of imaginary connections of resulting polylines are close to straight line, that angle should be near 0.0 degree - 0.0 isn't allowed so you must enter 1.0 or some small angle, and if projections are curving, like in my posted example then you should enter angle close to difference angles of adjacent segments of imaginary projection polyline...

[CAB]

Marko,
Running the routine I get a copy of the original less the north end segments.
Not an outside trace as requested. I used one & 5 & then 10 as the angle tolerance.

[cadplayer]

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

[CAB]

My approach would be to create an average or center line & then plot the points that were the greatest distance from one side & then the other side.

[ribarm]

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

Tolerance angle is little greater angle than greatest angle of differences between all pairs of adjacent segments of imaginary reconstruction 3dpolys... For ex. approx. angle between seg1 and seg2 is 10 degrees; between seg2 and seg3 is 12.5 degrees, between seg3 and seg4 is 11.0 degrees... From these angles greatest one is 12.5 degrees => tolerance angle is just little greater than 12.5 degrees => 12.6 degrees... But note that tolerance angle must be less than between segments that do zig-zag of real top projection of reference 3dpoly that you pick... So if zig-zag angle is 30 degrees, 12.6 degrees will satisfy this case, but if you enter tolerance 35 degrees, CAD will assume that first point list vertices that are to be used in entmaking first of 2 recreation 3dpolys are the same as original point list of picked reference 3dpoly, so CAD will entmake 1st 3dpoly the same as picked reference 3dpoly, and 2nd 3dpoly won't make... So this angle is important to be exact... In some cases in witch zig-zag angle is smaller than greatest adjacent imaginary angle of 3dpoly that is to be made it is impossible to create these 2 3dpolys... Simply CAD will overdraw 3dpoly over original 3dpoly... This is my approach, maybe there is better way, but be aware that this are 3dpolys that you are operating with so center 3dpoly for reference that could be used for making first and second reconstruct 3dpolys from each side isn't possible to determine, so perhaps you could make center reference 2d poly and according to this reference do operation of entmaking 3dpolys from each side in 3d...

[ribarm]

Sorry, I had mistake in my code... Please, do test it now - look in my post where I modified the code...

M.R.

[cadplayer]

Hi Marco!

I must thinking little more, I don´t get working your function in all cases.
Thanks a lot!

[ribarm]

cadplayer, please check my revision of your DWG - see attachment... DWG is in R2010 file format...

M.R.

[CAB]

For me (ACAD2006) it just traces over existing pline.

[ribarm]

Here are 2 helper codes for preparing DWG...

Code - Auto/Visual Lisp: [Select]

1. (defun c:clean3dpoly (/ ss 3dpl vert pt ptlst ptlstclean)
2.   (prompt "\nPick 3dpoly to clean its overlapping vertices")
3.   (while (not ss)
4.     (setq ss (ssget "_+.:E:S:L" (list '(0 . "POLYLINE") '(-4 . "&=") '(70 . 8))))
5.     (if (not ss) (prompt "\nMissed, try again..."))
6.   )
7.   (setq 3dpl (ssname ss 0))
8.   (setq vert 3dpl)
9.   (while (and (setq vert (entnext vert)) (eq (cdr (assoc 0 (entget vert))) "VERTEX"))
10.     (setq pt (cdr (assoc 10 (entget vert))))
11.     (setq ptlst (cons pt ptlst))
12.   )
13.   (setq ptlst (reverse ptlst))
14.   (setq ptlstclean (acet-list-remove-duplicates ptlst 1e-2))
15.   (entmake (vl-remove-if '(lambda (x) (member (car x) '(-1 5))) (entget 3dpl)))
16.   (foreach pt ptlstclean
17.     (entmake
18.       (list
19.         '(0 . "VERTEX")
20.         '(100 . "AcDbEntity")
21.         '(100 . "AcDbVertex")
22.         '(100 . "AcDb3dPolylineVertex")
23.         (cons 10 pt)
24.         '(70 . 32)
25.       )
26.     )
27.   )
28.   (entmake
29.     (list
30.       '(0 . "SEQEND")
31.       '(100 . "AcDbEntity")
32.     )
33.   )
34.   (entdel 3dpl)
35.   (princ)
36. )
37.  

Code - Auto/Visual Lisp: [Select]

1. (defun c:clean3dpolys (/ ss)
2.  
3.   (defun clean3dpoly (3dpl / vert pt ptlst ptlstclean)
4.     (setq vert 3dpl)
5.     (while (and (setq vert (entnext vert)) (eq (cdr (assoc 0 (entget vert))) "VERTEX"))
6.       (setq pt (cdr (assoc 10 (entget vert))))
7.       (setq ptlst (cons pt ptlst))
8.     )
9.     (setq ptlst (reverse ptlst))
10.     (setq ptlstclean (acet-list-remove-duplicates ptlst 1e-2))
11.     (entmake (vl-remove-if '(lambda (x) (member (car x) '(-1 5))) (entget 3dpl)))
12.     (foreach pt ptlstclean
13.       (entmake
14.         (list
15.           '(0 . "VERTEX")
16.           '(100 . "AcDbEntity")
17.           '(100 . "AcDbVertex")
18.           '(100 . "AcDb3dPolylineVertex")
19.           (cons 10 pt)
20.           '(70 . 32)
21.         )
22.       )
23.     )
24.     (entmake
25.       (list
26.         '(0 . "SEQEND")
27.         '(100 . "AcDbEntity")
28.       )
29.     )
30.     (entdel 3dpl)
31.   )
32.  
33.   (prompt "\nSelect 3dpolys to clean their overlapping vertices")
34.   (while (not ss)
35.     (setq ss (ssget "_:L" (list '(0 . "POLYLINE") '(-4 . "&=") '(70 . 8))))
36.     (if (not ss) (prompt "\nEmpty selection, try again..."))
37.   )
38.   (mapcar '(lambda (x) (clean3dpoly x)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
39.   (princ)
40. )
41.  

This is intended to be used for DWG that has 3dpolys with overlapping vertices - so in "3dpoly.dwg" you attached Dirk...

[cadplayer]

Hi Marko!

Sorry for dellay. I come a bit forward and would like use your routine more practically. Your routine works fine, but if I run I have to know which tollerance I must type in. In my example it was 7.67 deg, but how can I know this in beginning. Have I to measure every segmentsdiff in angle or is there a esier way. I try to generate all diffence angles some text. I would be nice it comes before I must type in tollerance angle.
A big compliment to your effort.

Code: [Select]

(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)

)

 

[ymg]

Don't know if it is always the case, but in your example simply separating  the polylines every  2 vertices will give you the two polylines you are after.

So you end up with (0 1 4 5 8 9 ... etc.) and (2 3 6 7 10 11... etc.) , here the numbers are indices to each vertex.

Normally when a surveyor take point to be joined, he should not cross the street like that but go along one side and come back along the other side.

ymg

[cadplayer]

cannot follow you, which value you was typing. I only see a list of what?
Surveyor can go after lines but it´s not always useful, on 2 km road it haves repeatly same codes so it is better to go "sectionwise" /Dirk