Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

lisp to label cross section

0 REPLIES 0
Reply
Message 1 of 1
marlance
3955 Views, 0 Replies

lisp to label cross section

Hi all,

 

I modified this code again based on the chainage lisp posted here.

(defun c:polen (/ datum dist ld obj plen plength pt row rowh tox txtpos)

  (vl-load-com)
(defun _text (p b o h c)
       (entmake
	 (append
	   '((0 . "TEXT")
	     (100 . "AcDbEntity")
	     (67 . 0)
	     (410 . "Model")
	     (7 . "GHD Standard Arial")
	     (8 . "C-CH_LABL")
	     (100 . "AcDbText")
	     )
	   (list (cons 10 (polar p (+ b PI) tox))
		 )
	   (list (cons 40 h))
	   (list (cons 1 (strcat ""  (if (setq ld (nth (strlen (rtos  c 2 0)) '(x  "00" "")))
				
				   	ld "")
				 (rtos c 2 2))))
	   (list (cons 50 (+ b (/ PI 2) )))
	   
	   '((41 . 1.0)
	     (51 . 0.0)
	     (71 . 0)
	     (72 . 0)
	     (11 0.0 0.0 0.0)
	     (210 0.0 0.0 1.0)
	     (100 . "AcDbText")
	     (73 . 0)
	     )
	   )
	 )
  )

  ;;;		Modified by pBe		;;;
  (defun _ang (en d pt)
    (+ (angle '(0.0 0.0 0.0)
	      (vlax-curve-getfirstderiv
		en
		(vlax-curve-getparamatpoint en pt)
		)
	      )
       (* pi 1.5)
       )
    )
  
  ;;;		Modified by pBe		;;;
(setq datum (getdist"\nEnter datum: "))
(setq height (getdist"\nEnter text height: "))
(setq row (getreal"\nChoose row: "));;;;select where to place text
(setq tox (/ height 5));;offset from x axis
(setq rowh (* (* (/ height 2) 10)-1))
(setq txtpos (+ (* rowh row)(/ height 2)))
(setq dist 10)
(setq offset 2);0
(setq to 2);0
  (setq	ss    (ssget)
	count 0
	)
  (repeat (sslength ss)
    (setq ent	   (ssname ss count)
	  obj	   (vlax-ename->vla-object ent)
	  chainage dist
   plen (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
	  )
    (setq p (vlax-curve-getstartpoint ent))
    (setq p2 (vlax-curve-getendpoint ent))
(setq pt (list (car p) (+ (cadr p) txtpos )));;;;;;insertion point of text	
    (setq plength ( + datum plen))
    ;;;	Additional option / re-arrange sequence		;;;
    
    ;;;;modified by mircea to get the elevation value of polyline
    (_text pt (_ang ent chainage p) to height plength)
    
    ;;; 	Start/Mid/End mode iI Length is less than or equal twice the value of dist variable	;;;
    (if	(<= (setq ln (vlax-curve-getdistatparam
		       ent
		       (vlax-curve-getendparam ent)
		       )
		  )
	    (* 2 dist)
	    )
    
      (while
	(setq point1 (vlax-curve-getPointAtDist obj chainage))
	(setq bearing (_ang ent (+ chainage dist) point1))
	
	(setq chainage (+ chainage dist))
	)
      )

    (setq count (1+ count))
    )


  (princ)
  )

 

the attached image (on the middle) is generated by this code by selecting the yellow lines.

can it be possible to achieve the image on the right side?

 

regards,

roldan

 

 

0 REPLIES 0

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost