3d poly elevation as label

3d poly elevation as label

BB8x
Advocate Advocate
959 Views
8 Replies
Message 1 of 9

3d poly elevation as label

BB8x
Advocate
Advocate

Hi all

 

I need tool to amend 3d poly with elevation (3 digits 0.001) written on same layer, align with poly and moved from poly for 0.05 units

 

I found tool to do that, but it creates elevation on poly without moving from poly and I need to do it manually thousands of those

 

Thanks

0 Likes
Accepted solutions (2)
960 Views
8 Replies
Replies (8)
Message 2 of 9

ronjonp
Mentor
Mentor

This is what I use from Alan Thompson. It creates an mtext field with a mask so you don't have to move it.

 

0 Likes
Message 3 of 9

BB8x
Advocate
Advocate

Do not know how to use it tbh. Keep asking Specify next point [Undo]

I was imaging this as selecting all 3dpolies (like 550 of them) on the drawing and hit enter

0 Likes
Message 4 of 9

ronjonp
Mentor
Mentor

@BB8x 

It's a fence selection. Where it intersects the polylines it will place the label.

It could easily be modified to select all and place on the midpoint or something.

0 Likes
Message 5 of 9

BB8x
Advocate
Advocate

I did not mention before, but I need vertexes only please

 

0 Likes
Message 6 of 9

BB8x
Advocate
Advocate

Alternatively need tool to move text for 0.05 "up"

Left-right direction is direction of texts. Lets say text has rotation 177 deg, so up is 177deg-90deg

Sample attached

0 Likes
Message 7 of 9

calderg1000
Mentor
Mentor

Regards @BB8x 

Try this code

(defun c:mtx( / s en enp)
  (setq s(ssget "_A" '((0 . "*text"))))
  (repeat (setq i(sslength s))
    (setq en(entget(ssname s (setq i(1- i))))
     enp(assoc 10 en))
    (setq en(entmod(subst (cons 10 (mapcar '+ (cdr enp) '(0. 0.1 0.))) enp en)))
    )
  )

 

 


Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

0 Likes
Message 8 of 9

ronjonp
Mentor
Mentor
Accepted solution

@BB8x 

Give this a try. It's not to cleanup the mess but to do the job right in the first place.

 

(defun c:foo (/ a n l p s)
  ;; RJP » 2022-04-28
  ;; Make Readable  -  Lee Mac
  ;; Returns a given angle corrected for text readability
  (defun lm:makereadable (a)
    ((lambda (a)
       (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
	 (+ a pi)
	 a
       )
     )
      (rem (+ a pi pi) (+ pi pi))
    )
  )
  (if (setq s (ssget '((0 . "POLYLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq n -1)
      (setq l (assoc 8 (entget e)))
      (repeat (1+ (fix (vlax-curve-getendparam e)))
	(setq p (vlax-curve-getpointatparam e (setq n (1+ n))))
	(setq a (lm:makereadable (angle '(0 0) (vlax-curve-getfirstderiv e n))))
	(entmake (list '(0 . "TEXT")
		       '(100 . "AcDbEntity")
		       l
		       '(100 . "AcDbText")
		       (cons 10 (polar p (+ a (/ pi 2)) 0.05))
		       '(40 . 0.18)
		       (cons 1 (vl-string-subst "," "." (rtos (last p) 2 3)))
		       (cons 50 a)
		       '(41 . 1.)
		       '(51 . 0.)
		       '(7 . "Standard")
		       '(71 . 0)
		       '(72 . 0)
		       (cons 11 (list 0. 0. (last p)))
		       '(100 . "AcDbText")
		       '(73 . 0)
		 )
	)
      )
    )
  )
  (princ)
)

 

 

0 Likes
Message 9 of 9

CADaSchtroumpf
Advisor
Advisor
Accepted solution

Try this ?

(defun c:label_Z_vertex ( / js AcDoc Space n ent pr pt_start deriv rtx nw_obj)
  (princ "\nSelect polylines.")
  (while
    (null
      (setq js
        (ssget
          '(
            (0 . "*POLYLINE")
            (-4 . "<NOT")
              (-4 . "&") (70 . 112)
            (-4 . "NOT>")
          )
        )
      )
    )
    (princ "\nSelect is empty, or isn't POLYLINE!")
  )
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (repeat (setq n (sslength js))
    (setq
      ent (ssname js (setq n (1- n)))
      pr -1
    )
    (repeat (1+ (fix (vlax-curve-getEndParam ent)))
      (setq
        pt_start (vlax-curve-GetPointAtParam ent (setq pr (1+ pr)))
        deriv (vlax-curve-getFirstDeriv ent pr)
        rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR")))
      )
      (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi)))
      (setq nw_obj
        (vla-addMtext Space
          (vlax-3d-point (polar pt_start (+ rtx (* pi 0.5)) 0.15))
          0.0
          (rtos (caddr pt_start) 2 3)
        )
      )
      (mapcar
        '(lambda (pr val)
          (vlax-put nw_obj pr val)
        )
        (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation 'BackgroundFill)
        (list 7 (getvar "TEXTSIZE") 5 (polar pt_start (+ rtx (* pi 0.5)) 0.15) "Standard" (getvar "CLAYER") rtx -1)
      )
    )
  )
  (prin1)
)
0 Likes