Lisp Modification

[inaamazmi]

I got a lisp that marks the intersection length as chainage. i want two modification.. the chainage text should be in "0+000.000" format the precision should be according to drawing

the lisp is here

vl-load-com)

(defun C:PipeAcrossStat ( / :GetInters ss en y d pt)

;----- Lee Mac ~ 19.01.10 www.theswamp.org
(defun :GetInters (ss / list->3D-point i j obj1 obj2 iLst)
(defun list->3D-point (lst)
(if lst (cons (list (car lst) (cadr lst) (caddr lst))
(list->3D-point (cdddr lst)))))
(setq i (sslength ss))
(while (not (minusp (setq j (1- i) i (1- i))))
(setq obj1 (vlax-ename->vla-object (ssname ss i)))
(while (not (minusp (setq j (1- j))))
(setq obj2 (vlax-ename->vla-object (ssname ss j))
iLst (append iLst (list->3D-point (vlax-invoke obj1 'IntersectWith obj2 acExtendNone))))))
iLst)

;---------------------------------------------------------------------

(if (and (princ "\nSelect ALL (poly)lines,")
(setq ss (ssget '((0 . "*LINE,ARC"))))
(not (initget 0))
(setq en (car (entsel "\nSelect a PIPELINE: ")))
(wcmatch (cdr (assoc 0 (entget en))) "*LINE")
(not (initget 0))
(setq y (cadr (getpoint "\nPick a dimension line: "))))
(foreach e (:GetInters ss)
(if (setq pt (list (car e) y 0.)
d (vlax-curve-getDistAtPoint en e))
(progn
(entmakex (list (cons 0 "LINE")
(cons 10 e)
(cons 11 pt)
(cons 8 "TEXT COVER")
(cons 62 210)
(cons 210 '(0. 0. 1.))
))
(entmakex (list (cons 0 "MTEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 8 "TEXT COVER")
(cons 10 pt)
(cons 40 2)
(cons 50 (* 0.5 pi))
(cons 1 (strcat (rtos d 2 2) "m"))
(cons 71 4)
(cons 62 1)
(cons 63 2)
(cons 90 1)
))
)))
(princ "\nWrong selection."))
(princ)
)

[inaamazmi]

sample drawing

[Moshe-A]

@inaamazmi ,

check this one

Moshe

(vl-load-com)

(defun C:PipeAcrossStat ( / zeroPrefix :GetInters ss en y d pt)

 (defun zeroPrefix (n l / k s)
  (if (<= (setq k (strlen (itoa n))) l)
   (progn 
    (setq s (itoa n))
    (cond
     ((zerop (- l k))
      (itoa n)
     ); case
     ( t
      (repeat (- l k)
       (setq s (strcat "0" s)) 
      )
     ); case 
    ); cond
   ); progn
   "" ; return 
  ); if
 ); zeroPrefix

  
;----- Lee Mac ~ 19.01.10 www.theswamp.org
 (defun :GetInters (ss / list->3D-point i j obj1 obj2 iLst)
   
  (defun list->3D-point (lst)
   (if lst (cons (list (car lst) (cadr lst) (caddr lst))
    (list->3D-point (cdddr lst)))
   )
  )
   
  (setq i (sslength ss))
  (while (not (minusp (setq j (1- i) i (1- i))))
   (setq obj1 (vlax-ename->vla-object (ssname ss i)))
     
   (while (not (minusp (setq j (1- j))))
    (setq obj2 (vlax-ename->vla-object (ssname ss j))
          iLst (append iLst (list->3D-point (vlax-invoke obj1 'IntersectWith obj2 acExtendNone)))
     )
   )
  )
   
  iLst
 ); :GetInters

;---------------------------------------------------------------------

 (if (and (princ "\nSelect ALL (poly)lines,")
          (setq ss (ssget '((0 . "*LINE,ARC"))))
          (not (initget 0))
          (setq en (car (entsel "\nSelect a PIPELINE: ")))
          (wcmatch (cdr (assoc 0 (entget en))) "*LINE")
          (not (initget 0))
          (setq y (cadr (getpoint "\nPick a dimension line: ")))
     )
  (foreach e (:GetInters ss)
   (if (setq pt (list (car e) y 0.)
             d (vlax-curve-getDistAtPoint en e))
    (progn
     (entmakex (list
		(cons 0 "LINE")
                (cons 10 e)
                (cons 11 pt)
                (cons 8 "TEXT COVER")
                (cons 62 210)
                (cons 210 '(0. 0. 1.))
              )
    )
    
    (entmakex (list
	       (cons 0 "MTEXT")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbMText")
               (cons 8 "TEXT COVER")
               (cons 10 pt)
               (cons 40 2)
               (cons 50 (* 0.5 pi))
              ; (cons 1 (strcat (rtos d 2 2) "m"))
               (cons 1 (strcat "0+" (zeroPrefix d 3) "." (zeroPrefix 0 3) "m"))
               (cons 71 4)
               (cons 62 1)
               (cons 63 2)
               (cons 90 1)
             )
     )
    ); progn
   ); if
  ); foreach
  (princ "\nWrong selection.")
 ); if
  
 (princ)
)

[inaamazmi]

@Moshe-A  showing eror

[Moshe-A]

@inaamazmi ,

As your request my part was format the text "+0.000.000"

i did not have success on running this lisp cause i do not know how?!

Moshe

[pbejse · Accepted solution]

---

@inaamazmi wrote:

I got a lisp that marks the intersection length as chainage. i want two modification.. the chainage text should be in "0+000.000" format the precision should be according to drawing

---

(defun C:PipeAcrossStat	(/ :GetInters ss en y d pt)
  
(defun _format ( n / nr ns i h)
  (setq head 
	(cond
	  ((setq h (nth (1- (setq i (strlen (setq nr (itoa (fix n))))))
		     	'("00" "0" "")))(strcat "0+" h (rtos n 2 )))
	  ((strcat (substr nr 1 (- i 3)) "+"
		   (substr (rtos n 2 ) (- i 3)))
	   )
	  )
	)
  )
  
;----- Lee Mac ~ 19.01.10 www.theswamp.org
  (defun :GetInters (ss / list->3D-point i j obj1 obj2 iLst)
    (defun list->3D-point (lst)
      (if lst
	(cons (list (car lst) (cadr lst) (caddr lst))
	      (list->3D-point (cdddr lst))
	)
      )
    )
    (setq i (sslength ss))
    (while (not	(minusp	(setq j	(1- i)
			      i	(1- i)
			)
		)
	   )
      (setq obj1 (vlax-ename->vla-object (ssname ss i)))
      (while (not (minusp (setq j (1- j))))
	(setq obj2 (vlax-ename->vla-object (ssname ss j))
	      iLst (append
		     iLst
		     (list->3D-point
		       (vlax-invoke obj1 'IntersectWith obj2 acExtendNone)
		     )
		   )
	)
      )
    )
    iLst
  )

;---------------------------------------------------------------------

  (if (and (princ "\nSelect ALL (poly)lines,")
	   (setq ss (ssget '((0 . "*LINE,ARC"))))
	   (not (initget 0))
	   (setq en (car (entsel "\nSelect a PIPELINE: ")))
	   (wcmatch (cdr (assoc 0 (entget en))) "*LINE")
	   (not (initget 0))
	   (setq y (cadr (getpoint "\nPick a dimension line: ")))
      )
    (foreach e (:GetInters ss)
      (if (setq	pt (list (car e) y 0.)
		d  (vlax-curve-getDistAtPoint en e)
	  )
	(progn
	  (entmakex (list (cons 0 "LINE")
			  (cons 10 e)
			  (cons 11 pt)
			  (cons 8 "TEXT COVER")
			  (cons 62 210)
			  (cons 210 '(0. 0. 1.))
		    )
	  )
	  (entmakex (list (cons 0 "MTEXT")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbMText")
			  (cons 8 "TEXT COVER")
			  (cons 10 pt)
			  (cons 40 2)
			  (cons 50 (* 0.5 pi))
			  (cons 1 (strcat (_format d) "m"))
			  (cons 71 4)
			  (cons 62 1)
			  (cons 63 2)
			  (cons 90 1)
		    )
	  )
	)
      )
    )
    (princ "\nWrong selection.")
  )
  (princ)
)

HTH

[inaamazmi]

Thanks for your help it working @pbejse