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

Lisp to grab stationing and update matchline block

0 REPLIES 0
Reply
Message 1 of 1
shannongreen_17
697 Views, 0 Replies

Lisp to grab stationing and update matchline block

The video "mlt lisp example" shows what the code should do but the video "trial run" shows what happens when i try to use the code. The code is supposed to update the match line sheet number and station note. I only need it to update the stationing as i have found a way to make the sheet number update based on the numbering in the tab.

I know nothing about lisp and would like to get the code to work as shown in the video. If there is a way to automate it to make the lisp step through each page and perform the operation without having to activate the code on each page that would be SUPER helpful. The most important thing however is that the code works as intended. Any help with this would be much appreciated.

 

(vl-load-com)
(command "cmdecho" 0)


(defun c:mlt ()
(command "undo" "m")
(command "tilemode" 0)
(command "pspace")
(command "zoom" "e")
(setq wpt (list 0.463161 0.301459 0.0))
(setq wpt2 (list 16.4438 10.6306 0.0))
(setq ss (ssget "c" wpt wpt2 (list (cons 0 "insert")(cons 2 "`*U*")(cons 8 "0"))))
(command "mspace")
(if (= cl nil)(setq cl (car (entsel "\nSelect stationing centerline: "))))
(command "pspace")
(setq g 0 lis '())
(repeat (sslength ss)
(line_to_mspace)
(find_intersection)
(command "tilemode" 0)
(update_matchline)
(command "pspace")
(setq g (+ g 1))
)
(setq g 0)
(setq cur (atoi (getvar "ctab")))
(if (> (nth 0 lis) (nth 1 lis))(setq dwg (itoa (+ cur 1)) dwg2 (itoa (- cur 1))))
(if (< (nth 0 lis) (nth 1 lis))(setq dwg (itoa (- cur 1)) dwg2 (itoa (+ cur 1))))
(dep 1)(setq fna1 (cons 1 ttc))(setq b (subst (cons 1 dwg) fna1 (entget d)))
(entmod b)
(setq g (+ g 1))
(dep 1)(setq fna1 (cons 1 ttc))(setq b (subst (cons 1 dwg2) fna1 (entget d)))
(entmod b)

 

(command "mspace")
(command "erase" lin "")
(princ)
)


(defun line_to_mspace ()
(setq in (cdr (assoc 10 (entget (ssname ss g)))))
(setq ang (cdr (assoc 50 (entget (ssname ss g)))))
(setq pt (polar in (+ (+ ang pi) 1.5708) 5.0))
(setq pt2 (polar in (+ ang 1.5708) 5.0))
(command "pline" pt pt2 "")
(setq lin (entlast))
(command "chspace" lin "")
(command "tilemode" 1)
(command "zoom" "e")
(princ)
)


(defun find_intersection ()
(setq ob1 (vlax-ename->vla-object lin))
(setq ob2 (vlax-ename->vla-object cl))
(command "change" lin cl "" "p" "e" "0.0" "")
(setq lst (nth 0 (group3 (vlax-invoke ob1 'intersectwith ob2 acextendnone))))
(princ)
)


(defun group3 ( lst / rtn )
(repeat (/ (length lst) 3)
(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
lst (cdddr lst)
))
(reverse rtn)
)


(defun integer_to_station (integer)
(setq integer (itoa integer))
(if (= (strlen integer) 1)(setq integer (strcat "00" integer)))
(if (= (strlen integer) 2)(setq integer (strcat "0" integer)))
(setq stasec (substr integer (- (strlen integer) 1) 2))
(setq firsta (substr integer 1 (- (strlen integer) 2)))
(setq combsta (strcat firsta "+" stasec))
(princ)
)


(defun update_matchline ()
(setq di (fix (vlax-curve-getdistatpoint cl lst)))
(integer_to_station di)
(dep 2)(setq fna1 (cons 1 ttc))(setq b (subst (cons 1 combsta) fna1 (entget d)))
(entmod b)
(setq lis (append lis (list di)))
(princ)


)


(defun dep (hdep)
(setq x 1)
(setq b (entget (ssname ss g)))
(setq c (cdr (assoc -1 b)))
(repeat hdep
(setq d (entnext c))
(setq c d)
(setq ttc (cdr (assoc 1 (entget d))))
(setq x (+ x 1))
(princ)
))

 

(princ)

0 REPLIES 0

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

Post to forums  

Technology Administrators