Jump to content

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


aridzv

Recommended Posts

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

Link to comment
Share on other sites

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.

 

 

  • Like 1
Link to comment
Share on other sites

@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 by aridzv
Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 :D

 

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

 

Link to comment
Share on other sites

@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.

Capture.JPG

Link to comment
Share on other sites

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

 

Link to comment
Share on other sites

@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 by aridzv
Link to comment
Share on other sites

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 by Trudy
Link to comment
Share on other sites

@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 by aridzv
Link to comment
Share on other sites

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

 

 

 

 

Link to comment
Share on other sites

I cant start this lisp for some reason :D

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...