How to get the angle and offset factor of a polyline?

How to get the angle and offset factor of a polyline?

adaptacad
Advocate Advocate
1,226 Views
7 Replies
Message 1 of 8

How to get the angle and offset factor of a polyline?

adaptacad
Advocate
Advocate

I'm trying to create a "I think it's simple" function.
I want to select one or more polylines and insert text at the beginning, end and middle, with a certain offset factor.
the beginning of the middle the end i managed to get. But how can I get the rotation and displacement of the text? here what i have so far.
Who can help me I'm very grateful!!

 

(defun c:demo ( )
  ;;criar um layer par aos textos
  (setq text "TEXT - TEST 0011")
  (setq oFac 1.0) ;; Offset Factor
  (setq tSze 1.5) ;; Text Size
  
  (if (setq sel (ssget '((0 . "*LINE"))))
    (progn
      (foreach ple (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
        (setq obj (vlax-ename->vla-object ple))
        (setq pt1 (vlax-curve-getstartpoint obj))
        (setq pt2 (vlax-curve-getendpoint obj))        
        (setq Dist1st (vlax-curve-getDistAtPoint obj pt1))
        (setq Dist2st (vlax-curve-getDistAtPoint obj pt2))        
        (setq PlineLen (- Dist2st Dist1st))
        (setq PointMid (vlax-curve-getPointAtDist obj (+ Dist1st (* 0.5 PlineLen))))
      )
    );progn
  );if
)

 

 

adaptacad_0-1622658089754.png

 

0 Likes
Accepted solutions (1)
1,227 Views
7 Replies
Replies (7)
Message 2 of 8

Kent1Cooper
Consultant
Consultant

When it's a Polyline, does it ever have any change(s) in direction, or is it always a single line segment [or multiple collinear line segments] as in the image?  [I ask because if the latter, it's much easier to do what you want, but if the former, it can still be done.]

Kent Cooper, AIA
0 Likes
Message 3 of 8

Kent1Cooper
Consultant
Consultant

And by the way, a simplification suggestion:

....
(setq pt1 (vlax-curve-getstartpoint obj))
(setq pt2 (vlax-curve-getendpoint obj))
;; (setq Dist1st (vlax-curve-getDistAtPoint obj pt1)) ;; <-- will always be zero, so not needed
;; (setq Dist2st (vlax-curve-getDistAtPoint obj pt2)) ;; <-- put directly into PlineLen variable
;; (setq PlineLen (- Dist2st Dist1st)) ;; <-- no calculation necessary

(setq PlineLen (vlax-curve-getDistAtPoint obj pt2)) ;; <-- in place of above 3 lines
;; (setq PointMid (vlax-curve-getPointAtDist obj (+ Dist1st (* 0.5 PlineLen)))) ;; <-- adding to 0

(setq PointMid (vlax-curve-getPointAtDist obj (* 0.5 PlineLen))) ;; <-- simpler
....

Kent Cooper, AIA
0 Likes
Message 4 of 8

adaptacad
Advocate
Advocate

@Kent1Cooper wrote:

When it's a Polyline, does it ever have any change(s) in direction,


YES Polylines and Lines

0 Likes
Message 5 of 8

ronjonp
Mentor
Mentor
Accepted solution

See if this sheds any light:

 

(defun c:demo (/ a ept mpt ofac p pa ple sel stpt text tsze) ; <- LOCALIZE VARIABLES
  (defun _getobjectangleatpoint	(ename pt /)
    (if
      (and
	(= 'list (type (setq p (vl-catch-all-apply 'vlax-curve-getclosestpointto (list ename pt)))))
	(setq pa (vlax-curve-getparamatpoint ename p))
	(setq a (angle '(0 0 0) (vlax-curve-getfirstderiv ename pa)))
      )
       a
    )
  )
  ;;criar um layer par aos textos
  (setq text "TEXT - TEST 0011")
  (setq ofac 1.0)
  ;; Offset Factor
  (setq tsze 1.5)
  ;; Text Size
  (if (setq sel (ssget '((0 . "*LINE"))))
    (progn (foreach ple	(vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
	     ;; (setq obj (vlax-ename->vla-object ple))
	     ;; Curve functions run faster on enames
	     (setq stpt (vlax-curve-getstartpoint ple))
	     (setq ept (vlax-curve-getendpoint ple))
	     (setq mpt (vlax-curve-getpointatdist ple (/ (vlax-curve-getdistatpoint ple ept) 2.)))
	     (foreach p	(list stpt mpt ept)
	       (if (setq a (_getobjectangleatpoint ple p))
		 (entmake (list	'(0 . "TEXT")
				'(100 . "AcDbEntity")
				'(8 . "text")
				'(100 . "AcDbText")
				;; Perpendicular angle to segment
				(cons 10 (polar p (+ a (/ pi 2)) ofac))
				(cons 40 tsze)
				(cons 1 text)
				(cons 50 a)
				'(11 0. 0. 0.)
			  )
		 )
	       )
	     )
	   )
    )
  )
  (princ)
)

 

0 Likes
Message 6 of 8

adaptacad
Advocate
Advocate

Thanks @ronjonp 

0 Likes
Message 7 of 8

ronjonp
Mentor
Mentor

Glad to help. 🍻

0 Likes
Message 8 of 8

diagodose2009
Collaborator
Collaborator

I upgrade your-version of programe

=You must calculate TextSize with (getvar "TextSize")

 

(setq	 ofac (getvar "TEXTSIZE")
	 tsze (getreal (strcat "\nvoid setTextSize(" (rtos ofac 2 3) ");"))
	 tsze (if (not (numberp tsze)) (* ofac 3) tsze)
	 tsze (abs tsze)
)

 

=You must add TextPrefix at each-angles

=You mus request which-mode , you test (Ename) or (Vla-Object)

 

(setq	 dyn (if fss (dfn_getx_readkey "[EOX]" "\nRunOnce.exe (E.enames)(O.Object)(A.about):=") "0")))

 

=You see Normal-Version of LispSource

 

(defun nn_vmload(/ $rr dip adc bios ldcw opl3 dos ofac agp8x mdk dyn nop tex lha fss tsze lzh lpt rst epl mpt ept stt pcp arj jge) ; <- LOCALIZE VARIABLES
  (setq;|a11974|;
	 bios (read "dfn_getobjectangleatpoint")
	 dos (getvar "DWGNAME")) (if (and (=  (type dos) (read "STR")) (>  dos "")) (progn  (setq;|a12084|;
	 tex (getstring (strcat "\nvoid addText(none As " dos ");"))
	 tex (if (=  tex nil) dos tex))) (progn  (setq;|a12178|;
	 tex (getstring "\nvoid addTextExtents(bCanExt);")) (if (=  tex nil) (exit)))) (vl_load_com) (setq;|a12284|;
	 tex (if (>  tex "") tex (getvar "PROGRAM"))
	 ofac (getvar "TEXTSIZE")
	 tsze (getreal (strcat "\nvoid setTextSize(" (rtos ofac 2 3) ");"))
	 tsze (if (not (numberp tsze)) (* ofac 3) tsze)
	 tsze (abs tsze)
	 ofac (dfn_color_ceinc nil 5)
	 ofac (car (list (* 1.0 ofac 0.3) "Offset Factor calculate byCEColor"))
	 tsze (car (list 1.5 "Text Size"))
	 fss (ssget (list (cons 0 "*LINE")))
	 $rr nil
	 dyn (if fss (dfn_getx_readkey "[EOX]" "\nRunOnce.exe (E.enames)(O.Object)(A.about):=") "0")) (setq;|a12742|;
	 lpt (if fss (dfn_ssg_tolistvla fss) nil)) (setq;|a12780|;
	 ldcw (if (=  dyn "O") (car lpt) (if (=  dyn "E") (cadr lpt) nil))) (if (=  dyn "A") (progn  (alert readme.txt) (exit))) (setq;|a12900|;
	 dip nil) (if ldcw (foreach ple ldcw (setq;|a12974|;
	 stt (vlax-curve-getstartpoint ple)
	 ept (vlax-curve-getendpoint ple)
	 mpt (vlax-curve-getpointatdist ple (* (vlax-curve-getdistatpoint ple ept) 0.5))
	 lzh (list stt mpt ept)
	 adc (- 0 1)
	 lha (foreach pcp lzh (setq nop (apply bios (list ple pcp))) (if nop (setq $rr (cons nop $rr)) nil))
	 nop (foreach agp8x lzh (setq adc (+ 1 adc) jge (nth adc lha)) (if agp8x (setq dip (cons (polar agp8x (+ jge kHalfPi) ofac) dip)) "0") (if agp8x (entmakex (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 "0") (cons 100 "AcDbText") (cons 10 (car dip)) (cons 40 tsze) (cons 1 (strcat tex (angtos jge))) (cons 50 jge) (list 11 0.0 0.0 0.0))) "@"))))) (setq;|a13772|;
	 mpt (getvar "VIEWCTR")
	 adc (dfn_color_ceinc nil 1)
	 $rr nil
	 lzh (foreach ept dip (setq adc (dfn_color_ceinc adc 1) $rr (append $rr (list adc ept mpt))))) 
$rr)

 

=You can develope DebugVersion of sourceLisp(for AntiHack and Crack yourVlx)

 

(defun nn_vmload(/ $rr dip adc bios ldcw opl3 dos ofac agp8x mdk dyn nop tex lha fss tsze lzh lpt rst epl mpt ept stt pcp arj jge) ; <- LOCALIZE VARIABLES
  (setq;|a11974|;
	 bios (jc_aro10 "C001read" (list  "dfn_getobjectangleatpoint"))
	 dos (jc_aro10 "C002getvar" (list  "DWGNAME"))) (if (and (=  (type dos) (jc_aro10 "C003read" (list  "STR"))) (>  dos "")) (progn  (setq;|a12084|;
	 tex (jc_aro10 "C004getstring" (list  (strcat "\nvoid addText(none As " dos ");")))
	 tex (if (=  tex nil) dos tex))) (progn  (setq;|a12178|;
	 tex (jc_aro10 "C005getstring" (list  "\nvoid addTextExtents(bCanExt);"))) (if (=  tex nil) (exit)))) (jc_aro10 "C006vl_load_com" (list )) (setq;|a12284|;
	 tex (if (>  tex "") tex (jc_aro10 "C007getvar" (list  "PROGRAM")))
	 ofac (jc_aro10 "C008getvar" (list  "TEXTSIZE"))
	 tsze (jc_aro10 "C009getreal" (list  (strcat "\nvoid setTextSize(" (jc_aro10 "C010rtos" (list  ofac 2 3)) ");")))
	 tsze (if (not (jc_aro10 "C011numberp" (list  tsze))) (* ofac 3) tsze)
	 tsze (abs tsze)
	 ofac (jc_aro10 "C012dfn_color_ceinc" (list  nil 5))
	 ofac (car (list (* 1.0 ofac 0.3) "Offset Factor calculate byCEColor"))
	 tsze (car (list 1.5 "Text Size"))
	 fss (jc_aro10 "C013ssget" (list  (list (jc_aro10 "C014cons" (list  0 "*LINE")))))
	 $rr nil
	 dyn (if fss (jc_aro10 "C015dfn_getx_readkey" (list  "[EOX]" "\nRunOnce.exe (E.enames)(O.Object)(A.about):=")) "0")) (setq;|a12742|;
	 lpt (if fss (jc_aro10 "C016dfn_ssg_tolistvla" (list  fss)) nil)) (setq;|a12780|;
	 ldcw (if (=  dyn "O") (car lpt) (if (=  dyn "E") (jc_aro10 "C017cadr" (list  lpt)) nil))) (if (=  dyn "A") (progn  (jc_aro10 "C018alert" (list  readme.txt)) (exit))) (setq;|a12900|;
	 dip nil) (if ldcw (foreach ple ldcw (setq;|a12974|;
	 stt (jc_aro10 "C019vlax-curve-getstartpoint" (list  ple))
	 ept (jc_aro10 "C020vlax-curve-getendpoint" (list  ple))
	 mpt (jc_aro10 "C021vlax-curve-getpointatdist" (list  ple (* (jc_aro10 "C022vlax-curve-getdistatpoint" (list  ple ept)) 0.5)))
	 lzh (list stt mpt ept)
	 adc (- 0 1)
	 lha (foreach pcp lzh (setq nop (apply bios (list ple pcp))) (if nop (setq $rr (jc_aro10 "C023cons" (list  nop $rr))) nil))
	 nop (foreach agp8x lzh (setq adc (+ 1 adc) jge (nth adc lha)) (if agp8x (setq dip (jc_aro10 "C024cons" (list  (jc_aro10 "C025polar" (list  agp8x (+ jge kHalfPi) ofac)) dip))) "0") (if agp8x (jc_aro10 "C026entmakex" (list  (list (jc_aro10 "C027cons" (list  0 "TEXT")) (jc_aro10 "C028cons" (list  100 "AcDbEntity")) (jc_aro10 "C029cons" (list  8 "0")) (jc_aro10 "C030cons" (list  100 "AcDbText")) (jc_aro10 "C031cons" (list  10 (car dip))) (jc_aro10 "C032cons" (list  40 tsze)) (jc_aro10 "C033cons" (list  1 (strcat tex (jc_aro10 "C034angtos" (list  jge))))) (jc_aro10 "C035cons" (list  50 jge)) (list 11 0.0 0.0 0.0)))) "@"))))) (setq;|a13772|;
	 mpt (jc_aro10 "C036getvar" (list  "VIEWCTR"))
	 adc (jc_aro10 "C037dfn_color_ceinc" (list  nil 1))
	 $rr nil
	 lzh (foreach ept dip (setq adc (jc_aro10 "C038dfn_color_ceinc" (list  adc 1)) $rr (jc_aro10 "C039append" (list  $rr (list adc ept mpt)))))) 
$rr)

 

 

0 Likes