- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello experts!
I found this lisp by Tharwat, that counts intersections between two points and it creates a table from the layer info.
I need help to change it so instead of choosing two points I can select the line/pline and get all the intersections in one table for the whole length of the line. Also, if possible, ad at what length along the line/pline the intersection occurs. Would this be possible?
Here’s the code:
(defun c:Test (/ entities i number integer layers lst object point1 p
height point2 result selectionset selectionsetname
singlelayer model table r c inc
)
(vl-load-com)
(if (and (setq point1 (getpoint "\n Specify first point :"))
(setq point2 (getpoint point1 "\n Specify Second point :"))
(setq selectionset
(ssget "_F"
(list point1 point2)
'((0 . "LINE,*POLYLINE"))
)
)
(setq p (getpoint "\n Table insertion point :"))
)
(progn
(setq height (if (zerop (cdr (assoc 40
(setq st
(entget
(tblobjname "STYLE" (getvar 'textstyle))
)
)
)
)
)
(cdr (assoc 42 st))
(cdr (assoc 40 st))
)
)
(repeat (setq integer (sslength selectionset))
(setq entities (cons (setq selectionsetname
(ssname
selectionset
(setq integer (1- integer))
)
)
entities
)
)
(if (not (member (setq singlelayer
(cdr (assoc 8 (entget selectionsetname)))
)
layers
)
)
(setq layers (cons singlelayer layers))
)
)
(setq i 0)
(foreach layer layers
(repeat (setq number (length entities))
(if
(eq
(cdr
(assoc 8
(entget (nth (setq number (1- number)) entities))
)
)
layer
)
(setq lst (cons layer (setq i (1+ i))))
)
)
(setq result (cons lst result))
(setq i 0)
)
(setq model (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq table (vla-addtable
model
(vlax-3d-point p)
(1+ (length result))
2
(* height 2.)
(* height 10.)
)
)
(vla-settext table 0 0 "Section A - B")
(setq r 0
c 0
inc -1
)
(repeat (length result)
(vla-settext
table
(setq r (1+ r))
c
(car (nth (setq inc (1+ inc)) result))
)
(vla-settext
table
r
(setq c (1+ c))
(itoa (cdr (nth inc result)))
)
(setq c 0)
)
)
)
(princ)
)
Solved! Go to Solution.