labelling horizontal line or vertical line coordinate parallel to line

February 6, 2015

Dear all,

Do you have a lisp to labelling horizontal line or vertical line coordinate, just the line's Northing or Easting coordinate parallel to line ,it can be above ,under or on line, can chose location. and can labelling several lines one time.

thanks a lot.

February 6, 2015

I moved your thread to the AutoLISP, Visual LISP & DCL Forum.

February 7, 2015

thanks SLW210

February 9, 2015

thanks SLW210

Tips:

command: _dimordinate

also can prefix "N=" or "E=" , but it only shows positive value

Updated v1.1: works with LWPOLYLINE & POLYLINE

10.02.2015

http://www.cadtutor.net/forum/showthread.php?90807-labelling-horizontal-line-or-vertical-line-coordinate-parallel-to-line&p=621946#post621946

;; Make Angle Readable      ;credit to ymg       
(defun MakeReadable (a)
 (setq a (rem (+ a pi pi) (+ pi pi)))
 (rem (if (< (* pi 0.5) a (* pi 1.5))
 (+ a pi)
 a
 ) ;_ end of if
      (+ pi pi)
      ) ;_ end of rem
 ) ;_ end of defun

[color="red"];v1.1: works with LWPOLYLINE & POLYLINE[/color]
(defun c:test (/ _text ss 2p e lst split glc l)
;hanhphuc 09.02.2015
;label Vertical & Horizontal Grid (WCS)
 (defun _text (tx lst / txsize rot pt)
   (setq txsize (getvar 'textsize)
  rot	 (MakeReadable (apply 'angle lst))
  pt	 (polar	(apply 'mapcar (cons ''((a b) (* 0.5 (+ a b))) lst))
		(+ rot (/ pi 2.))
		(* txsize 3.0)
		) ;_ end of polar
  ) ;_  end of setq
   (entmake (list '(0 . "TEXT")
	   '(72 . 1) ; justify
	   (cons 1 tx)
	   (cons 10 pt)
	   (cons 11 pt) ; justify
	   (cons 40 txsize)
	   (cons 50 rot)
	   ) ; list
     ) ;_ end of entmake
   ) ;_ end of defun


(defun split (lst len / l ls)
 (while lst
   (repeat len (setq l (cons (car lst) l) lst (cdr lst)))
   (setq ls (cons (reverse l ) ls) l nil)
 )
 (vl-remove-if ''((x)(vl-some 'not x)) (reverse ls))
 )

(defun glc (e / obj l cor) ; get *lines coordinates
;hanhphuc 2014
 (setq obj (vlax-ename->vla-object e))
 (foreach p '("Coordinates" "EndPoint" "StartPoint")
   (if	(vlax-property-available-p obj p)
     (setq l (cons p l))
     ) ;_ end of if
   ) ;_ end of foreach
 (setq cor (mapcar ''((p) (vlax-get obj p)) l))
 (eval	(cons 'cond
      (reverse (vl-list* '(t cor)
			 (mapcar ''((a b)
				    (list
				     (list '= (cdr (assoc 0 (entget e))) a)
				     (cons 'quote (list (split (car cor) b)))
				     )
				    )
				 '("LWPOLYLINE" "POLYLINE" )
				 '(2 3)
				 ) ;_ end of mapcar
			 ) ;_ end of vl-list*
	       ) ;_ end of reverse
      ) ;_ end of cons
) ;_ end of eval
 ) ;_ end of defun
 
(prompt "\nSelect grid lines.. ")
 (setq ss (ssget ":L" '((0 . "*LINE"))))
 (repeat (sslength ss)
   (setq lst (glc (setq e (ssname ss 0))))
   (foreach 2p	(mapcar ''((a b) (list a b)) lst (cdr lst))
     (eval
(cons 'cond
      (mapcar '(lambda (a b)
		 (list
		       (equal (car (setq l (mapcar a 2p))) (cadr l) 1.0e-
		       (cons '_text (list (strcat b (rtos (car l) 2 3)) '2p))
		       ) ;_ end of list
		 ) ;_ end of lambda
	      '(car cadr)
	      '("E= " "N= ") ; or '("X= " "Y= ")
	      ) ;_ end of mapcar
      ) ;_ end of cons
) ;_ end of eval
     (princ)
     ) ;_ end of foreach
   (ssdel e ss)
   ) ;_ end of repeat
(princ)
 ) ;_ end of defun

HTH

Edited February 10, 2015 by hanhphuc
now user can label on polyline as requested

February 10, 2015

thanks a lot!!!!

@hanhphuc ，I have test the lisp,it work very nice for "line",but it can not labelling the "ployline""3dpoly",could you please add the function to it, thanks a bunch....

February 10, 2015

thanks a lot!!!!
@hanhphuc ，I have test the lisp,it work very nice for "line",but it can not labelling the "ployline""3dpoly",could you please add the function to it, thanks a bunch....

you are welcome xinmh

updated post#4

February 11, 2015

you are welcome xinmh
updated post#4

perfect!!

thanks a lot!!!

you are so warmheart!!!

October 2, 2019

On 2/9/2015 at 1:18 PM, hanhphuc said:

Tips:

command: _dimordinate

also can prefix "N=" or "E=" , but it only shows positive value

Updated v1.1: works with LWPOLYLINE & POLYLINE

10.02.2015


http://www.cadtutor.net/forum/showthread.php?90807-labelling-horizontal-line-or-vertical-line-coordinate-parallel-to-line&p=621946#post621946

;; Make Angle Readable      ;credit to ymg       
(defun MakeReadable (a)
 (setq a (rem (+ a pi pi) (+ pi pi)))
 (rem (if (< (* pi 0.5) a (* pi 1.5))
 (+ a pi)
 a
 ) ;_ end of if
      (+ pi pi)
      ) ;_ end of rem
 ) ;_ end of defun

[color="red"];v1.1: works with LWPOLYLINE & POLYLINE[/color]
(defun c:test (/ _text ss 2p e lst split glc l)
;hanhphuc 09.02.2015
;label Vertical & Horizontal Grid (WCS)
 (defun _text (tx lst / txsize rot pt)
   (setq txsize (getvar 'textsize)
  rot	 (MakeReadable (apply 'angle lst))
  pt	 (polar	(apply 'mapcar (cons ''((a b) (* 0.5 (+ a b))) lst))
		(+ rot (/ pi 2.))
		(* txsize 3.0)
		) ;_ end of polar
  ) ;_  end of setq
   (entmake (list '(0 . "TEXT")
	   '(72 . 1) ; justify
	   (cons 1 tx)
	   (cons 10 pt)
	   (cons 11 pt) ; justify
	   (cons 40 txsize)
	   (cons 50 rot)
	   ) ; list
     ) ;_ end of entmake
   ) ;_ end of defun


(defun split (lst len / l ls)
 (while lst
   (repeat len (setq l (cons (car lst) l) lst (cdr lst)))
   (setq ls (cons (reverse l ) ls) l nil)
 )
 (vl-remove-if ''((x)(vl-some 'not x)) (reverse ls))
 )

(defun glc (e / obj l cor) ; get *lines coordinates
;hanhphuc 2014
 (setq obj (vlax-ename->vla-object e))
 (foreach p '("Coordinates" "EndPoint" "StartPoint")
   (if	(vlax-property-available-p obj p)
     (setq l (cons p l))
     ) ;_ end of if
   ) ;_ end of foreach
 (setq cor (mapcar ''((p) (vlax-get obj p)) l))
 (eval	(cons 'cond
      (reverse (vl-list* '(t cor)
			 (mapcar ''((a b)
				    (list
				     (list '= (cdr (assoc 0 (entget e))) a)
				     (cons 'quote (list (split (car cor) b)))
				     )
				    )
				 '("LWPOLYLINE" "POLYLINE" )
				 '(2 3)
				 ) ;_ end of mapcar
			 ) ;_ end of vl-list*
	       ) ;_ end of reverse
      ) ;_ end of cons
) ;_ end of eval
 ) ;_ end of defun
 
(prompt "\nSelect grid lines.. ")
 (setq ss (ssget ":L" '((0 . "*LINE"))))
 (repeat (sslength ss)
   (setq lst (glc (setq e (ssname ss 0))))
   (foreach 2p	(mapcar ''((a b) (list a b)) lst (cdr lst))
     (eval
(cons 'cond
      (mapcar '(lambda (a b)
		 (list
		       (equal (car (setq l (mapcar a 2p))) (cadr l) 1.0e-
		       (cons '_text (list (strcat b (rtos (car l) 2 3)) '2p))
		       ) ;_ end of list
		 ) ;_ end of lambda
	      '(car cadr)
	      '("E= " "N= ") ; or '("X= " "Y= ")
	      ) ;_ end of mapcar
      ) ;_ end of cons
) ;_ end of eval
     (princ)
     ) ;_ end of foreach
   (ssdel e ss)
   ) ;_ end of repeat
(princ)
 ) ;_ end of defun

hi Hanhphuc; just used your code and its giving me a message error: malformed list on input. Could you please help me

HTH

October 2, 2019

7 hours ago, CADWORKER said:

Find this line

(equal (car (setq l (mapcar a 2p))) (cadr l) 1.0e-

it is missing the final integer and the closing brace

The brace is easy but the final integer (8) is a guess as this was an error that occured when the system software was upgraded. See reason for edit

(equal (car (setq l (mapcar a 2p))) (cadr l) 1.0e-8)

Edited October 2, 2019 by dlanorh
Reminded by LeeMac of system upgrade problem

October 16, 2019

On 10/3/2019 at 4:43 AM, dlanorh said:
Find this line
(equal (car (setq l (mapcar a 2p))) (cadr l) 1.0e-
it is missing the final integer and the closing brace

Thanks dlanorh,

it was mentioned which 8 ) became smiley was automatic removed in the code tags by the system.

p/s quite long time inactive

Edited October 16, 2019 by hanhphuc

Sign In

labelling horizontal line or vertical line coordinate parallel to line

Recommended Posts

xinmh

SLW210

xinmh

hanhphuc

xinmh

hanhphuc

xinmh

CADWORKER

dlanorh

hanhphuc

Join the conversation

Tutorials

Forums

Activity