Code Red > AutoLISP (Vanilla / Visual)
Edit LISP to find geometric center and ignore duplicates in a list.
(1/1)
osa:
Hi, I am still in the process of learning AUTOLISP, and would like to edit some script. Recently I asked a question on autodesk and someone gave me this code which I am grateful for. but I have been trying to edit it for the past few days.
basically it selects a polyline, finds intersection points with the polyline and selected objects, then places text at points of intersection
the problem is
1- many times the polyline intersects twice with an object, so it places two text objects
2- the text should be at the geometric center of the polyline or block if necessary to transform it.
i really have tried and it was too complex for my level .. any help would be truly appreciated.
--- Code - Auto/Visual Lisp: ---(vl-load-com) (defun c:IntersNumbering ( / LM:intersections p s l o z e) (or *in-n* (setq *in-n* 0)) ;; Intersections - Lee Mac ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod) ) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst)))) (reverse rtn)) ; ====================================================================================================== (if (and (setq p (car (entsel "\nSelect a polyline: ") );car );setq (princ "Select intersecting polylines and blocks, ") (setq s (ssget '((0 . "LWPOLYLINE,LINE,INSERT")))) (or (ssdel p s) t) (setq *in-n* (cond ((setq f (getint (strcat "\nStart with <" (itoa (1+ *in-n*)) ">: "))) (1- f)) (*in-n*))) (setq o (vlax-ename->vla-object p)) (setq l '() z (getvar 'textsize)) );and (repeat (setq i (sslength s)) (setq e (vlax-ename->vla-object (ssname s (setq i (1- i)))) l (append (LM:intersections o e acextendnone) l)))) (and l (setq l (vl-sort l '(lambda (p1 p2) (< (vlax-curve-getdistatpoint p p1) (vlax-curve-getdistatpoint p p2))))) (foreach p l (entmake (list (cons 0 "TEXT") (cons 10 p) (cons 40 z) (cons 1 (itoa (setq *in-n* (1+ *in-n*)))))))) (princ) )
It's Alive!:
Welcome OSA
I moved your question to the lisp section :-)
DEVITG:
Please upload your sample.dwg
Navigation
[0] Message Index
Go to full version