Contour elevation labelling - need help with changing the routine from PLINE to 3DPOLYLINE

April 5, 2021

Hi,
I've found the attached lisp that label contours.
the problem is that it for PLINE (x,y and Elevation)
I need help with changing it to work with 3DPOLYLINE (x,y,z), and the use the Z value of the first vertex of every contour line as the contour line level value.

(actually, we can use any vertex of the contour line for the elevation value... I just thought it will be easier to use the first...)

Thanks,

Ari.

Label_Side_Elevation.LSP

April 5, 2021

You do not really want to use 3DPOLYLINEs for contours. You want to use Polylines with a z value.

A contour is all at one level - that is the whole point of them. 3DPolylines can only have continuous linetype and can only be curve fit with splines, which are nasty things to work with.

If your contour IS a 3DPolyline, explode it and make it an ordinary Polyline. You will find it much easier to deal with.

April 5, 2021

@eldon

O.k. - 2Dpoly.

but still - I need help with changing it from PLINE (x,y and fixed elevation - DXF Code 38) to 2DPOLYLINE/3DPOLYLINE (x,y,z) that use DXF Code 10,

and the biggest problem is how I get the first vertex Z value (code 10).

with polyline it is simple - there is one elevation for the entity, and with x-y-z polyline I need to find a way to write a code that take the VERTEX No.1 Z value.

thanks,

Ari.

Edited April 5, 2021 by aridzv

April 5, 2021

Hello aridzv can you upload .dwg and i think i can help you

April 5, 2021

@Trudy

Hi and thanks!

yes,

I've uploaded here a drawing of contour lines.

it will be grate if you will be able to help.

Thanks,

Ari.

contours.dwg

April 5, 2021

Hello @aridzv this code will convert 3D poly to 2D with elevation.

If you want i can try something with labeling.


(defun c:3dpto2d ( / listt XY sel Vname coord) ; selection set
(setq sel (ssget '((0 . "POLYLINE"))))

(repeat (setq i (sslength sel))
	(setq Vname (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
	(if (equal (vlax-get Vname 'ObjectName) "AcDb3dPolyline")
		(progn
			(setq coord (vlax-get Vname 'coordinates))
			(setq listt (LM:group-n coord 3))
				(foreach x listt (setq XY (cons (list (car x) (cadr x)(caddr x)) XY)))
					(ENTMAKE
						(APPLY
						(FUNCTION APPEND)
						(CONS (LIST '(0 . "LWPOLYLINE")
									'(100 . "AcDbEntity")
									'(67 . 0)
									'(410 . "Model")
									(cons 8 (getvar 'clayer))
									'(100 . "AcDbPolyline")
									(CONS 90 (LENGTH XY))
									(if (= (vlax-get Vname 'Closed) 0) (cons 70 0) (cons 70 1))
								)
								(MAPCAR (FUNCTION LIST)
										(MAPCAR (FUNCTION (LAMBDA (XY) (CONS 10 XY))) XY)                     
								)
						)
						)
					)
					(setq Z (nth 2 (car XY)))
					(entmod (subst (cons 38 z) (assoc 38 (entget (entlast))) (entget (entlast))))
			(setq XY nil)
		)
	)
)
(princ)
)

April 5, 2021

13 minutes ago, Trudy said:

Hello @aridzv this code will convert 3D poly to 2D with elevation.

If you want i can try something with labeling.

@Trudy

yes,if you can add elevation labeling that will be grate - this is the main goal of this LSP.

many thanks,

Ari.

April 5, 2021

Hello @aridzv i make something its not the best but for the start.

1.First you have to make the 3dPoly to Polyline with first lisp.

2.Start "Label1" and select all

3.Write what is the lenght between labels and i think this is.

The lisp will generate you block.

I can modify the lisp if you want .

From that i see you are geodesist, we have to help each other

(defun insD (X Y nam scal listt / aDoc ib)
(vl-load-com)

(setq block (vla-InsertBlock
              (vla-get-modelspace
                (vla-get-activedocument
                  (vlax-get-acad-object)
                )
              )
              (vlax-3D-point X Y)
              nam
              scal
              scal
              scal
              0
            )
      )
(mapcar '(lambda (j k)
			(vla-put-textstring k (eval j))
		  )
			listt
			(vlax-invoke block 'GetAttributes)
)
(princ)
)

(defun Trudy_style ()
(progn
(if (= (tblsearch "style" "Trudy_style") 'nil)
		(entmakex
		'(
		(0 . "STYLE")
		(100 . "AcDbSymbolTableRecord")
		(100 . "AcDbTextStyleTableRecord")
		(2 . "Trudy_style")
		(70 . 0)
		(40 . 0.0)
		(41 . 1.0)
		(50 . 0.0)
		(71 . 0)
		(42 . 2.0)
		(3 . "Times New Roman.ttf")
		(4 . "")
		)
		)
)
(if (tblsearch "block" "Trudy_P") (princ)
(progn
  (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "Label1") (10 0 0 0) (70 . 2)))
  (entmake '((0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (8 . "Label Elevation") (100 . "AcDbText") (10  -1 0) (40 . 2) (1 . "") (50 . 0) (41 . 1) (51 . 0) (7 . "Trudy_style") (71 . 0) (72 . 1) (11 0 0 0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Label") (2 . "LABEL") (70 . 0) (73 . 0) (74 . 2) (280 . 0)))
  (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
  (princ)
)
)
)
)

(defun c:Label1 (/ sel dist dist1 Vname lengPL)
(Trudy_style)
(setq dist1 (getreal "\nSet distance between Labels: "))
(setq sel (ssget '((0 . "LWPOLYLINE"))))
	(repeat (setq i (sslength sel))
	(setq dist 0)
		(setq Vname (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
		(setq lengPL (vlax-get Vname 'LENGTH))
			(while (> lengPL (setq dist (+ dist dist1)))
				(insD (car (vlax-curve-getPointAtDist Vname dist)) (cadr (vlax-curve-getPointAtDist Vname dist)) "Label1" 1 (list (rtos (nth 2 (vlax-curve-getPointAtDist Vname dist)) 2 0)))
			)
		
	)
(princ)
)

April 5, 2021

@Trudy

the lisp work perfectly!

I'm not a geodesist, I'm an irrigation & water supply designer (Civil engineering)...

and yes - we should help each others

there 4 things I would change:

1. I would use regular text instead of the block.

2. I would enable the user to set the text height.

3. I would change the location of the text to be above the contour line.

4. if possible, align the text to the contour (I Guess this will be hard to do...).

I've attached screenshot of the results from your routine compared to the original- the small size value (889) is yours and the big one (886) is from the original.

and again - MANY THANKS!!!

Ari.

April 5, 2021

There is another post over at Forums/autodesk where the OP has asked for hundreds of plines with levels. So this is very similar.

Anyway re aligning text if you look into this

(DEFUN ALG-ANG (OBJ PNT)
  (ANGLE '(0. 0. 0.)
     (VLAX-CURVE-GETFIRSTDERIV
       OBJ
       (VLAX-CURVE-GETPARAMATPOINT
         OBJ
         PNT
       )
     )
  )
)

and

(SETQ ANG    (ALG-ANG PL X)
            ANG
            (COND ((< (/ PI 2) ANG (* PI 1.5)) (+ PI ANG))
                  (T ANG)
            )
          )

You need to consider readability of the text else will go upside down at times.

If you want label on pline then use Mtext and the option of a mask. I would recommend this rather than offset.

(defun AH:text (pt hgt str ang lr lor )
(entmake
	(list
		(cons 0 "MTEXT")
		(cons 100 "AcDbEntity")
		(cons 100 "AcDbMText")
		(cons 8 ah:labellay)
		(cons 42 1) 
		(cons 43 0) 
		(cons 44 1) 
		(cons 7 ah:txtsty)
		(cons 1 str)
		(cons 10 pt)
 		(cons 11 (list 0.0 0.0 0.0))
		(cons 210 (list 0.0 0.0 1.0))
		(cons 40 hgt)
		(cons 50 ang)
		(cons 71 lr)
		(cons 72 lor)
	)
)
)

; add background mask to mtext just created
; By AlanH 2021 

(defun AH:BG (/ obj ent data elist mtwidth)
    (entmod (subst '(41 . 0.) (assoc 41 (setq data (entget (setq ent (entlast))))) data)) 
	(setq obj (vlax-ename->vla-object ent))
    (if (= (vlax-get-property obj 'BackgroundFill) :vlax-true)
      (vlax-put-property obj 'BackgroundFill :vlax-false)
      (progn
        (vlax-put-property obj 'BackgroundFill :vlax-true)
        (setq ent   (vlax-vla-object->ename obj)
              elist (entget ent)
              elist (subst (cons 90 3)(assoc 90 elist) elist) ;Use drawing background color
              elist (subst (cons 45 1.5) (assoc 45 elist) elist) ;Set 'Border Offset Factor' to 1.5
              mtwidth (* (cdr (assoc 42 elist))1.015)
              elist (subst (cons 41 mtwidth)(assoc 41 elist) elist) ;Trim excess width
        )
        (entmod elist)
      ) ; progn
    )
  (vl-cmdf "_draworder" ent "" "f")
  (princ)
)

April 6, 2021

I will modify it but can't these days (my personal computer is on service to be upgrade).

April 8, 2021

@Trudy

Thanks,

I'm looking forward to it!!

Ari.

April 8, 2021

@BIGAL

Thank for the reply.

I'm not concerned about masking the text.

My main goal is to create a lisp that will label contours.

It dosen't matter for me if the lisp will use 3D/2D poly or lwpolyline - I will manage my contours according to the lisp requirements.

I want a lisp that will prmopt me to choose the contour lines (a set of contours), then ask for a line that will be the path where those contour labels will be.

I will aprrisiate any help you can offer.

Thanks,

Ari.

Edited April 8, 2021 by aridzv

April 8, 2021

2 minutes ago, aridzv said:

Edited April 8, 2021 by aridzv

April 9, 2021

Hello @aridzv i create something but dont know if it will work how you want.

For now is super slow but work for this problem.

Edited: @aridzv if you copy the code, do it again because i edit him.

(vl-load-com)
(defun Trudy_style ()
(progn
(if (= (tblsearch "style" "Trudy_style") 'nil)
		(entmakex
		'(
		(0 . "STYLE")
		(100 . "AcDbSymbolTableRecord")
		(100 . "AcDbTextStyleTableRecord")
		(2 . "Trudy_style")
		(70 . 0)
		(40 . 0.0)
		(41 . 1.0)
		(50 . 0.0)
		(71 . 0)
		(42 . 2.0)
		(3 . "Times New Roman.ttf")
		(4 . "")
		)
		)
)
)
)

(defun T:MTEXT (coord rot text style height /)
			(entmake  
					(list      
						(cons 0 "MTEXT")    
						(cons 100 "AcDbEntity")          
						(cons 100 "AcDbMText")  						
						(cons 10 coord)  
						(cons 50 rot)
						(cons 71 5)
						(cons 72 5)
						(cons 73 1)
						(cons 1 text)
						(cons 40 height) 
						(cons 7 style)
					)
			)
)

(DEFUN ALG-ANG (OBJ PNT)
  (ANGLE '(0. 0. 0.)
     (VLAX-CURVE-GETFIRSTDERIV
       OBJ
       (VLAX-CURVE-GETPARAMATPOINT
         OBJ
         PNT
       )
     )
  )
)

(defun c:Label1 (/ sel dist dist1 Vname lengPL heig)
(Trudy_style)
(setq heig (getreal "\nSet text Height: "))
(setq dist1 (getreal "\nSet distance between Labels: "))
(setq sel (ssget '((0 . "LWPOLYLINE"))))
	(repeat (setq i (sslength sel))
		(setq dist 0)
		(setq Vname (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
		(setq lengPL (vlax-get Vname 'LENGTH))
			(while (> lengPL (setq dist (+ dist dist1)))
				(setq angg (ALG-ANG (ssname sel i) (vlax-curve-getPointAtDist Vname dist)))
				(setq angGG (* angg (/ 200 pi)))
				
				(T:MTEXT (polar (vlax-curve-getPointAtDist Vname dist) (+ angg (/ 100 (/ 200 pi))) heig) (if (> angGG 200) (/ (- angGG 200) (/ 200 pi)) angg) (rtos (nth 2 (vlax-curve-getPointAtDist Vname dist)) 2 0) "Trudy_style" heig)
			)		
	)

(princ)
)



(defun LM:group-n ( l n / r )
    (if l
        (cons
            (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
            (LM:group-n l n)
        )
    )
)

(defun c:3dpto2d ( / listt XY sel Vname coord) ; selection set
(setq sel (ssget '((0 . "POLYLINE"))))

(repeat (setq i (sslength sel))
	(setq Vname (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
	(if (equal (vlax-get Vname 'ObjectName) "AcDb3dPolyline")
		(progn
			(setq coord (vlax-get Vname 'coordinates))
			(setq listt (LM:group-n coord 3))
				(foreach x listt (setq XY (cons (list (car x) (cadr x)(caddr x)) XY)))
					(ENTMAKE
						(APPLY
						(FUNCTION APPEND)
						(CONS (LIST '(0 . "LWPOLYLINE")
									'(100 . "AcDbEntity")
									'(67 . 0)
									'(410 . "Model")
									(cons 8 (getvar 'clayer))
									'(100 . "AcDbPolyline")
									(CONS 90 (LENGTH XY))
									(if (= (vlax-get Vname 'Closed) 0) (cons 70 0) (cons 70 1))
								)
								(MAPCAR (FUNCTION LIST)
										(MAPCAR (FUNCTION (LAMBDA (XY) (CONS 10 XY))) XY)                     
								)
						)
						)
					)
					(setq Z (nth 2 (car XY)))
					(entmod (subst (cons 38 z) (assoc 38 (entget (entlast))) (entget (entlast))))
			(setq XY nil)
		)
	)
)
(princ)
)

Edited April 9, 2021 by Trudy

April 9, 2021

@Trudy

Many thanks!

your lisp works!

I've attached another lisp (Read the instructions in the file header).

it is a real contour app that we can use.

there are 2 things to improve there:

1. set an offset between the contour line and the label.

2. allow the contour to be at the current layer,because now they must be on specific layers ("Contour Major" and "Contour Minor).

if you will be able to help here, especially with No.1 issue we have here a real contour app!...

And again - Many thanks for your help so far!

Ari.

dlbl.lsp

Edited April 9, 2021 by aridzv

April 10, 2021

Trudy is this (/ 100 (/ 200 pi)) = (/ pi 2) so (setq pi2 (/ pi 2.0)) just 1 millisec calc.

Hi Trudy I think your doubling up in the entmake this was very limited test wise.

(setq Vname (vlax-ename->vla-object (car (entsel "Pick pline")))) ;replace with repeat ssname
(setq listt (LM:group-n (vlax-get Vname 'coordinates) 3))
(if (= (vlax-get Vname 'Closed) 0) (setq cls  0) (setq cls 1))
(setq z (nth 2 (nth 0 listt)))


(entmakex (append (list (cons 0 "LWPOLYLINE")
                         (cons 100 "AcDbEntity")
                         (cons 100 "AcDbPolyline")
                         (cons 90 (length listt))
                         (cons 70 cls))
                   (mapcar (function (lambda (p) (cons 10 p))) listt)))
				   
(entmod (subst (cons 38 z) (assoc 38 (entget (entlast))) (entget (entlast))))

April 11, 2021

@Trudy

Looks like it is done.

check it.

regards,

Ari.

Contour_Label.lsp

April 12, 2021

I cant start this lisp for some reason

If you want i can try to change my come more. With offset from line and diff layers i thik it will not be problem to make it work with 3dPoly.

@aridzv

April 12, 2021

@Trudy

read the instructions in the lsp file header.

see the new attachment here.

I've added an option to set the offset distance, but I cant set a default value...

see if you can help...

Contour_Label.lsp

Sign In

Contour elevation labelling - need help with changing the routine from PLINE to 3DPOLYLINE

Recommended Posts

aridzv

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

eldon

aridzv

Posted Images

eldon

aridzv

Trudy

aridzv

Trudy

aridzv

Trudy

aridzv

BIGAL

Trudy

aridzv

aridzv

aridzv

Trudy

aridzv

BIGAL

aridzv

Trudy

aridzv

Join the conversation

eldon

aridzv

Tutorials

Forums

Activity