TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: rayakmal on February 24, 2020, 05:34:58 PM
-
I use LM:intersections often, but sometimes the result is not as intended.
(defun c:inter ( / obj1 obj2 )
(if (and (setq obj1 (car (entsel "\nSelect 1st Object: ")))
(setq obj2 (car (entsel "\nSelect 2nd Object: ")))
)
(foreach pnt (LM:intersections (vlax-ename->vla-object obj1) (vlax-ename->vla-object obj2) acextendnone)
(entmake (list '(0 . "POINT") (cons 10 pnt)))
)
)
(princ)
)
(defun LM:Intersections ( obj1 obj2 mode / l r )
(setq l (vlax-invoke obj1 'intersectwith obj2 mode))
(repeat (/ (length l) 3)
(setq r (cons (list (car l) (cadr l) (caddr l)) r)
l (cdddr l)
)
)
(reverse r)
)
I attached the drawing, I use a UTM System Coordinate, the result: the point lies not on the Polyline.
I don't have this problem if the objects are situated near (0,0) (I use Autocad 2009).
Anyone can help me solve this problem?
I am thinking about working in UCS and transform the result back to WCS but I don't have any knowledge of this and right now need a fast solution.
Any pointer or help will be appreciated. Thanks
-
https://www.theswamp.org/index.php?topic=46848.0
-
https://www.theswamp.org/index.php?topic=46848.0
Thanks for the pointer, VovKa. After I tried all the sample functions on the thread I realized those are not what I'm looking for, then I came up with this code, it was inspired by CAB's codes BreakObjects.lsp and it works like a charm. Problem Solved.
;; Quick & Dirty Programming:
(defun c:BRK ( / en1 en2 iplist)
(setq en1 (entsel "\n#1 >> : ")
en1 (vlax-ename->vla-object (car en1))
en2 (entsel "\n#2 >> : ")
en2 (vlax-ename->vla-object (car en2))
)
(setq iplist (get_interpts en1 en2))
(setq iplist (list->3pair iplist))
(if iplist
(foreach n iplist
(entmake (list '(0 . "POINT") (cons 10 n)))
)
)
(princ)
)
;;;================BORROWED FROM BreakObjects.lsp ]====================
;;; Author: Copyright© 2006-2008 Charles Alan Butler
;;; Contact @ www.TheSwamp.org
;;; Requirements: objects must have the same z-value
;;;=====================================================================
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED ;
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR ;
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED. ;
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice below appear in all supporting documentation. ;
;;;=====================================================================
;; return a list of lists grouped by 3 from a flat list
(defun list->3pair (old / new)
(while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
old (cdddr old)))
(reverse new)
)
;;=====================================
;; return a list of intersect points
;;=====================================
(defun get_interpts (obj1 obj2 / iplist)
(if (not (vl-catch-all-error-p
(setq iplist (vl-catch-all-apply
'vlax-safearray->list
(list
(vlax-variant-value
(vla-intersectwith obj1 obj2 acextendnone)
))))))
iplist
)
)
-
Glad you got it sorted out. 8)