Topic: Help with code-slope of polyline

[nekonihonjin]

Hello everyone I need a lisp that, given a LWpolyline it converts ir to a 3Dpoly and ask for a slope value, then modify the elevation of the vertices to match that slope (in percentage).
I don't know if I made myself clear, but for an example let's say I enter a 10% slope, so if the distance of two vertices is 50 meter, then the Z value of the second vertice coordinates will have to be 5 meter higher.
This is what I got so far (it's not my work, I joined two lisp, one from jefferypsanders web page and the other I don't remeber who made it =(

Code: [Select]

(defun c:slope ( / Ent Obj Coordinates Index 3DCoordinates slope en)
  (vl-load-com)

  (if (setq Ent (entsel "Select a LWPOLYLINE : "))
    (if (equal (assoc 0 (entget (car Ent ))) '(0 . "LWPOLYLINE") )
      (progn
        (setq Obj (vlax-ename->vla-Object (car Ent )) )
        (setq Coordinates (vlax-get Obj "Coordinates" ) )
        (setq Index 0 )
        (while (nth Index Coordinates ) ;;------------------------------------------------------------------------------------------------V
          (setq 3DCoordinates (append 3DCoordinates (list (list (nth Index Coordinates )  (nth (1+ Index ) Coordinates ) 0.0 ))) )
          (setq Index (+ 2 Index ) )
        )
        (if (not (equal (vlax-curve-getStartPoint Obj ) (nth 0 3DCoordinates )))
          (setq 3DCoordinates (reverse 3DCoordinates ) )
          ( )
        )
        (vlax-release-Object Obj )
;; You may have to switch to WCS here first
        (command "._3Dpoly" )
        (foreach Pt_In 3DCoordinates (command Pt_In ) )
        (command)
        (command "._erase" Ent "")
        (princ "\nCommand: 3Dpolyline replaced LWpolyline. " )




   (setq slope (getreal))
 ;;;--- Get the entity's name
  (setq en(car(entsel "\n Select a PolyLine: ")))

  ;;;--- Get the DXF group codes of the entity
  (setq enlist(entget en))

  ;;;--- Create an empty list to hold the points
  (setq ptList(list))

  ;;;--- Get the sub-entities name
  (setq en2(entnext en))

  ;;;--- Get the dxf group codes of the sub-entity
  (setq enlist2(entget en2))

  ;;;--- While the polyline has a next vertice
  (while (not (equal (cdr(assoc 0 (entget(entnext en2))))"SEQEND"))

     ;;;--- Get the next sub-entity
     (setq en2(entnext en2))

     ;;;--- Get its dxf group codes
     (setq enlist2(entget en2))

     ;;;--- Check to make sure it is not a spline reference point
     (if(/= 16 (cdr(assoc 70 enlist2)))

       ;;;--- It is a vertex, save the point in a list [ptlist]
       (setq ptList(append ptList (list (cdr(assoc 10 enlist2)))))

      )
     )

      )
     (princ "...no LWPOLYLINE selected. " )
    )
    (princ "...no object selected. " )
  )
  (princ)
)
it turns the LWpoly to 3Dpoly, and puts its coordinates in a list, but I have no idea how to redraw the line with the slope.

The idea is to use the coordinates to obtain the distance between vertices, sqrt( (X2-X1)^2 + (Y2-Y1)^2 ) or maybe the autocad calculate it by itself; And then multiply this value by the percentage. Then add this value to the elevation (Z coord) of the second vertice.

making this with autolisp is very far from my reach.

Please help me.

[ribarm]

From the right side view it's clear that resulting polylines are planar... So does it really matters if LWPOLYLINE transforms to 3DPOLYLINE... Resulting polyline can be also LWPOLYLINE, right?

[nekonihonjin]

If you 3Dorbit the lines you'll see that they are 3D (the last two)

And it needs to get to 3D, What I'm trying to do is this:
by example
original               LWpoly   (0,0,0)     (10,0,0)      (20,0,0)     (35,10,0)
sloped +12%     3Dploy   (0,0,0)     (10,0,1.2)   (20,0,2.4)  (35,10,6.768)

The Z axis values incrementing at a rate of 12% of the X,Y plannar distance.

[ribarm]

Here, quickly written and resulting entity is LWPOLYLINE... You'll see that if you enter 9% it should be little smaller angle - look from right view... Also this can only work if you have A2009+ that is if your CAD supports PROJECTGEOMETRY command...

Code - Auto/Visual Lisp: [Select]

1. (defun c:slopelw ( / *error* ucsf pea lw slope a pl minp maxp reg el ss )
2.  
3.   (defun *error* ( msg )
4.     (if pea
5.       (setvar 'peditaccept pea)
6.     )
7.     (if msg
8.       (prompt msg)
9.     )
10.     (princ)
11.   )
12.  
13.   (if (eq (getvar 'worlducs) 0)
14.     (progn
15.       (command "_.UCS" "_W")
16.       (command "_.PLAN" "")
17.       (setq ucsf t)
18.     )
19.   )
20.   (setq pea (getvar 'peditaccept))
21.   (setvar 'peditaccept 1)
22.   (setq lw (car (entsel "\nPick open LWPOLYLINE that lies in WCS and has only straight segments...")))
23.   (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lw)))) lw 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw)))))
24.   (while (or (/= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (not (vl-every '(lambda ( p ) (= (last p) 0.0)) pl)) (not (vl-every '(lambda ( b ) (= b 0.0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget lw))))) (and (/= (cdr (assoc 70 (entget lw))) 0) (/= (cdr (assoc 70 (entget lw))) 128)))
25.     (progn
26.       (prompt "\nWrong entity pick...")
27.       (setq lw (car (entsel "\nPick open LWPOLYLINE that lies in WCS and has only straight segments...")))
28.       (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lw)))) lw 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw)))))
29.     )
30.   )
31.   (initget 3)
32.   (setq slope (getreal "\nSpecify slope angle in percentage : "))
33.   (setq a (atan (/ slope 100.0)))
34.   (setq minp (apply 'mapcar (cons 'min pl)))
35.   (setq maxp (apply 'mapcar (cons 'max pl)))
36.   (command "_.UCS" "_M" "_non" minp)
37.   (command "_.UCS" "_X" (cvunit a "radian" "degree"))
38.   (setq maxp (list (abs (- (car maxp) (car minp))) (abs (- (cadr maxp) (cadr minp))) 0.0))
39.   (setq minp '(0.0 0.0 0.0))
40.   (command "_.RECTANGLE" "_non" minp "_non" (list (car maxp) (/ (cadr maxp) (cos a)) 0.0))
41.   (command "_.REGION" (entlast) "")
42.   (command "_.PROJECTGEOMETRY" "_PRO" "_VIEW" lw "" (setq reg (entlast)))
43.   (while (< 0 (getvar 'cmdactive)) (command ""))
44.   (setq el reg ss (ssadd))
45.   (while (setq el (entnext el))
46.     (ssadd el ss)
47.   )
48.   (command "_.PEDIT" "_M" ss "" "_J")
49.   (while (< 0 (getvar 'cmdactive)) (command ""))
50.   (entdel reg)
51.   (command "_.UCS" "_P")
52.   (command "_.UCS" "_P")
53.   (*error* nil)
54. )
55.  

M.R.

[nekonihonjin]

That's just perfect!
I had understood (wrong for what I see) that a LWpolyline could only have a single Z value in all its vertices.

I must read more about that, your code is what I was looking for, as always thankyou very much.   

[nekonihonjin]

There is a problem when the line U turns, Check the file attached please.

[ribarm]

Then try just this :

Code - Auto/Visual Lisp: [Select]

1. (defun c:slopelw23dpoly ( / *error* ucsf lw pl slope a pln l )
2.  
3.   (defun *error* ( msg )
4.     (if ucsf
5.       (command "_.UCS" "_P")
6.     )
7.     (if msg
8.       (prompt msg)
9.     )
10.     (princ)
11.   )
12.  
13.   (if (= (getvar 'worlducs) 0)
14.     (progn
15.       (command "_.UCS" "_W")
16.       (setq ucsf t)
17.     )
18.   )
19.   (setq lw (car (entsel "\nPick open LWPOLYLINE that lies in WCS and has only straight segments...")))
20.   (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lw)))) lw 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw)))))
21.   (while (or (/= (cdr (assoc 0 (entget lw))) "LWPOLYLINE") (not (vl-every '(lambda ( p ) (= (last p) 0.0)) pl)) (not (vl-every '(lambda ( b ) (= b 0.0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 42)) (entget lw))))) (and (/= (cdr (assoc 70 (entget lw))) 0) (/= (cdr (assoc 70 (entget lw))) 128)))
22.     (progn
23.       (prompt "\nWrong entity pick...")
24.       (setq lw (car (entsel "\nPick open LWPOLYLINE that lies in WCS and has only straight segments...")))
25.       (setq pl (mapcar '(lambda ( p ) (trans (list (car p) (cadr p) (cdr (assoc 38 (entget lw)))) lw 0)) (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 10)) (entget lw)))))
26.     )
27.   )
28.   (initget 3)
29.   (setq slope (getreal "\nSpecify slope percentage : "))
30.   (setq a (atan (/ slope 100.0)))
31.   (setq pln (mapcar '(lambda ( p d ) (list (car p) (cadr p) (* d (/ (sin a) (cos a))))) pl (cons 0.0 (mapcar '(lambda ( d ) (apply '+ (setq l (cons d l)))) (mapcar '(lambda ( a b ) (distance a b)) pl (cdr pl))))))
32.   (command "_.3DPOLY")
33.   (foreach p pln
34.     (command "_non" p)
35.   )
36.   (command "")
37.   (*error* nil)
38. )
39.  

M.R.

[nekonihonjin]

I don't really get the hang of your code, but it'll be my homework.

I'll be using this routine to project underground access ramps, therefore there will be negative slopes.

is it ok if I just remove this line?:

Code: [Select]

(initget 7)

This will save me a lot a time at work, I really appreciate it.

[ribarm]

I don't really get the hang of your code, but it'll be my homework.

I'll be using this routine to project underground access ramps, therefore there will be negative slopes.

is it ok if I just remove this line?:

Code: [Select]

(initget 7)

This will save me a lot a time at work, I really appreciate it.

I am afraid that that's not desirable... To do negative sloping, I strongly suggest that you create positive one and then do MIRROR3D command with base point : 0,0,0 and selected plane of mirroring as XY plane (WCS plane)... Currently code is designed to operate with only positive elevations, but if you really wish to do testings change (initget 7) to (initget 3) that way only (1 - enter suppression + 2 - zero suppression = 3 ; 4 - negative values allowed) will be initiated for next (getreal) function that follows...

[EDIT : I've changed both codes to account for negative slope percentages... Also redefined them slightly to be more reliable...]

[roy_043]

@ ribarm:
The function c:slopelw23dpoly will now call itself if the user picks an invalid entity. But in that case something strange occurs. The 3DPOLY command will then be called twice. I don't think this is your intention.

Note that you can also validate the input by using an ssget filter. And to check if an LW poly is coplanar with the XY plane of the WCS you should also check its extrusion (= normal).

[roy_043]

My suggestion for the ssget filter:

Code - Auto/Visual Lisp: [Select]

1. (ssget
2.   "_+.:S"
3.   '(
4.     (0 . "LWPOLYLINE")
5.     (38 . 0.0)
6.     (210 0.0 0.0 1.0)
7.     (-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>")
8.     (-4 . "<NOT") (-4 . "/=") (42 . 0.0) (-4 . "NOT>")
9.   )
10. )

[ribarm]

You're right Roy, I've changed (if) condition... Wasn't really deep into it... Thanks for remark...

[EDIT : Had more issues and I wanted to loop if wrong pick so (if) changed to (while)...]

M.R.

[Stefan]

Hi nekonihonjin

Try this one. Works with positive or negative slope; closed or open lwpolylines, heavy polylines or 3Dpolylines. Bulged polylines are not ignored, but, obviously, the resulting 3d polylines is straightened out.
The 3D polyline starts from the original polyline start.
The original polyline can be WCS aligned or 3D rotated, but the new 3Dpolyline's slope is always measured parallel to WCS.

Code - Auto/Visual Lisp: [Select]

1. (defun C:TEST (/ e q i l p d)
2.   (if
3.     (and
4.       (setq e (ssget ":E:S" '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 118) (-4 . "NOT>"))))
5.       (setq q (getreal "\nSlope %: "))
6.     )
7.      (progn
8.        (setq i 0
9.              l (list (vlax-curve-getpointatparam (setq e (ssname e 0)) i))
10.        )
11.        (repeat (fix (vlax-curve-getendparam e))
12.          (setq p (vlax-curve-getpointatparam e (setq i (1+ i)))
13.                d (distance p (list (caar l) (cadar l)))
14.                l (cons (list (car p) (cadr p) (+ (caddar l) (* d q 0.01))) l)
15.          )
16.        )
17.        (entmakex
18.          '(
19.            (0 . "POLYLINE")
20.            (100 . "AcDbEntity")
21.            (100 . "AcDb3dPolyline")
22.            (70 . 8)
23.           )
24.        )
25.        (foreach x (reverse l)
26.          (entmakex
27.            (list
28.              '(0 . "VERTEX")
29.              '(100 . "AcDbEntity")
30.              '(100 . "AcDbVertex")
31.              '(100 . "AcDb3dPolylineVertex")
32.              (cons 10 x)
33.              '(70 . 32)
34.            )
35.          )
36.        )
37.        (entmakex '((0 . "SEQEND")))
38.      )
39.   )
40.   (princ)
41. )

[nekonihonjin]

You're right Roy, I've changed (if) condition... Wasn't really deep into it... Thanks for remark...

[EDIT : Had more issues and I wanted to loop if wrong pick so (if) changed to (while)...]

M.R.

Thanks again, it's great.

[nekonihonjin]

Hi nekonihonjin

Try this one. Works with positive or negative slope; closed or open lwpolylines, heavy polylines or 3Dpolylines. Bulged polylines are not ignored, but, obviously, the resulting 3d polylines is straightened out.
The 3D polyline starts from the original polyline start.
The original polyline can be WCS aligned or 3D rotated, but the new 3Dpolyline's slope is always measured parallel to WCS.

Code - Auto/Visual Lisp: [Select]

1. (defun C:TEST (/ e q i l p d)
2.   (if
3.     (and
4.       (setq e (ssget ":E:S" '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 118) (-4 . "NOT>"))))
5.       (setq q (getreal "\nSlope %: "))
6.     )
7.      (progn
8.        (setq i 0
9.              l (list (vlax-curve-getpointatparam (setq e (ssname e 0)) i))
10.        )
11.        (repeat (fix (vlax-curve-getendparam e))
12.          (setq p (vlax-curve-getpointatparam e (setq i (1+ i)))
13.                d (distance p (list (caar l) (cadar l)))
14.                l (cons (list (car p) (cadr p) (+ (caddar l) (* d q 0.01))) l)
15.          )
16.        )
17.        (entmakex
18.          '(
19.            (0 . "POLYLINE")
20.            (100 . "AcDbEntity")
21.            (100 . "AcDb3dPolyline")
22.            (70 . 8)
23.           )
24.        )
25.        (foreach x (reverse l)
26.          (entmakex
27.            (list
28.              '(0 . "VERTEX")
29.              '(100 . "AcDbEntity")
30.              '(100 . "AcDbVertex")
31.              '(100 . "AcDb3dPolylineVertex")
32.              (cons 10 x)
33.              '(70 . 32)
34.            )
35.          )
36.        )
37.        (entmakex '((0 . "SEQEND")))
38.      )
39.   )
40.   (princ)
41. )

Hi Stefan it reads this: 

error: malformed list on input

(I use autocad 2013)

[Stefan]

Wor

Hi Stefan it reads this: 

error: malformed list on input

(I use autocad 2013)

Works here. Are you sure you select the entire code? Check if there is a ")" after (princ).

[nekonihonjin]

Wor

Hi Stefan it reads this: 

error: malformed list on input

(I use autocad 2013)

Works here. Are you sure you select the entire code? Check if there is a ")" after (princ).

You're right, my bad 

it's working perfectly, thank you. 

[roy_043]

@ Stefan:
You are using:

Code: [Select]

(ssget ":E:S" ...)I find that the selection set can contain more than 1 item with this code. For example if entities are superimposed.

:E Everything within the cursor's object selection pickbox.

[Stefan]

@ Stefan:
You are using:

Code: [Select]

(ssget ":E:S" ...)I find that the selection set can contain more than 1 item with this code. For example if entities are superimposed.

:E Everything within the cursor's object selection pickbox.

Oh, no!! My whole life is a lie!! Seriously, I was convinced just one object is selected. Never tried to get another object other than (ssname ss 0) from a ":E:S" selection.
Well, trying your suggestion, "_+.:S", seems to solve the problem... But, as you do with every native command, when you want to select just a single object you make sure the selected object is the one you want by zooming the area.
Beside, if 2 objects are overlapping, your suggestion it does not guarantee that the selected object is the one you want.
Thanks for the heads up.