Topic: Help with lisp - intersections dimension

[PM]

Hi i am using Lee Mac code for intersection dimension. I add two lines in the code to work for annotation text. I want to ask if someone or Lee Mac can help. Is it possible to identify all lines,polylines, circles in specific layer and insert the dimensions. In my example i have 7 parallel  in layer DR_LINES. To dimension them i have to pick one line a time.Is it possible to autoselect all in layer DR_LINES and dimension them?

Code - Auto/Visual Lisp: [Select]

1. ;;-------------=={ Length Between Intersections }==-----------;;
2. ;;                                                            ;;
3. ;;  Displays the length of segments of a curve divided at     ;;
4. ;;  intersections with other objects.                         ;;
5. ;;------------------------------------------------------------;;
6. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
7. ;;------------------------------------------------------------;;
8. ;;  Version 1.4    -    26-04-2011                            ;;
9. ;;------------------------------------------------------------;;
10.  
11. (defun c:IntLen ( / *error* _iscurveobject e )
12.  
13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14.  
15. ; Add two lines for Annotation Text
16.  
17.   (command "_.-layer" "_make" "_DIM" "_color" 93 "" "_lweight" 0.30 "" "")
18.   (command "_.-style" "_diast" "wgsimpl.shx" "_annotative" "_yes" "_no" 1.75 1.2 0.0 "_no" "_no" "_no")
19.  
20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21.  
22.   (defun *error* ( msg )
23.     (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
24.         (princ (strcat "\n** Error: " msg " **")))
25.     (princ)
26.   )
27.  
28.   (defun _IsCurveObject ( entity / param )
29.     (and
30.       (not
31.         (vl-catch-all-error-p
32.           (setq param
33.             (vl-catch-all-apply 'vlax-curve-getendparam (list entity))
34.           )
35.         )
36.       )
37.       param
38.     )
39.   )
40.  
41.   (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
42.     (princ "\n--> Current Layer Locked.")  
43.     (while
44.       (progn (setvar 'ERRNO 0) (setq e (car (entsel)))
45.         (cond
46.           (
47.             (= 7 (getvar 'ERRNO))
48.  
49.             (princ "\n--> Missed, Try again.")
50.           )
51.           (
52.             (eq 'ENAME (type e))
53.  
54.             (if (_iscurveobject e)
55.               (LM:IntersectionLengths e)
56.               (princ "\n--> Invalid Object Selected.")
57.             )
58.             t
59.           )
60.         )
61.       )
62.     )
63.   )
64.   (princ)
65. )
66.  
67. ;;------------------------------------------------------------;;
68.  
69. (defun c:IntLenM ( / *error* ss i )
70.  
71.   (defun *error* ( msg )
72.     (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
73.         (princ (strcat "\n** Error: " msg " **")))
74.     (princ)
75.   )
76.  
77.   (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
78.     (princ "\n--> Current Layer Locked.")
79.     (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE"))))
80.       (repeat (setq i (sslength ss))
81.         (LM:IntersectionLengths (ssname ss (setq i (1- i))))
82.       )
83.     )
84.   )
85.  
86.   (princ)
87. )
88.  
89. ;;------------------------------------------------------------;;
90.  
91. (defun LM:IntersectionLengths
92.  
93.   ( e  ;; Entity name
94.    
95.     / *error* _startundo _endundo _groupbynum _sortbyparam _makereadable _isannotative _uniquefuzz
96.       a acspc c d d1 d2 da e i l ll m o ss ta to ts ur x y
97.   )
98.  
99.   (setq acdoc (cond ( acdoc ) ( (vla-get-activedocument (vlax-get-acad-object)) ))
100.         acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
101.   )
102.  
103.   (defun *error* ( msg )
104.     (if acdoc (_EndUndo acdoc))
105.     (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
106.         (princ (strcat "\n** Error: " msg " **")))
107.     (princ)
108.   )
109.  
110.   (defun _StartUndo ( doc ) (_EndUndo doc)
111.     (vla-StartUndoMark doc)
112.   )
113.  
114.   (defun _EndUndo ( doc )
115.     (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndoMark doc))
116.   )
117.  
118.   (defun _GroupByNum ( l n / r)
119.     (if l
120.       (cons
121.         (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
122.         (_GroupByNum l n)
123.       )
124.     )
125.   )
126.  
127.   (defun _SortbyParam ( e l )
128.     (vl-sort l '(lambda ( a b ) (< (vlax-curve-getParamatPoint e a) (vlax-curve-getParamatPoint e b))))
129.   )
130.  
131.   (defun _MakeReadable ( a )
132.     (
133.       (lambda ( a )
134.         (cond
135.           ( (and (> a (/ pi 2)) (<= a pi))
136.  
137.             (- a pi)
138.           )
139.           ( (and (> a pi) (<= a (/ (* 3 pi) 2)))
140.  
141.             (+ a pi)
142.           )
143.           ( a )
144.         )
145.       )
146.       (rem a (* 2 pi))
147.     )
148.   )
149.  
150.   (defun _isAnnotative ( style / object annotx )
151.     (and
152.       (setq object (tblobjname "STYLE" style))
153.       (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
154.       (= 1 (cdr (assoc 1070 (reverse annotx))))
155.     )
156.   )
157.  
158.   (defun _uniquefuzz ( lst fuzz )
159.     (if lst
160.       (cons (car lst)
161.         (_uniquefuzz
162.           (vl-remove-if '(lambda ( x ) (equal x (car lst) fuzz)) (cdr lst)) fuzz
163.         )
164.       )
165.     )
166.   )
167.  
168.   (setq ts
169.     (/ (getvar 'textsize)
170.       (if (_isAnnotative (getvar 'textstyle))
171.         (cond ( (getvar 'cannoscalevalue) ) ( 1.0 )) 1.0
172.       )
173.     )
174.   )
175.  
176.   (_StartUndo acdoc)
177.  
178.   (vla-getBoundingBox (setq o (vlax-ename->vla-object e)) 'll 'ur)
179.  
180.   (mapcar '(lambda ( x ) (set x (vlax-safearray->list (eval x)))) '(ll ur))
181.  
182.   (if
183.     (setq l
184.       (_sortbyparam e
185.         (_uniquefuzz
186.           (apply 'append
187.             (repeat
188.               (setq i
189.                 (sslength
190.                   (ssdel e
191.                     (setq ss
192.                       (ssget "_C" (trans ur 0 1) (trans ll 0 1) '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))
193.                     )
194.                   )
195.                 )
196.               )
197.               (setq l
198.                 (cons
199.                   (_groupbynum
200.                     (vlax-invoke o 'intersectwith
201.                       (vlax-ename->vla-object (ssname ss (setq i (1- i)))) acextendnone
202.                     )
203.                     3
204.                   )
205.                   l
206.                 )
207.               )
208.             )
209.           )
210.           1e-8
211.         )
212.       )
213.     )
214.     (if (not (vlax-curve-isClosed e))
215.       (progn
216.         (or
217.           (equal (vlax-curve-getStartParam e) (vlax-curve-getParamatPoint e (car l)) 0.001)
218.           (setq l (cons (vlax-curve-getStartPoint e) l))
219.         )
220.         (or
221.           (equal (vlax-curve-getEndParam e) (vlax-curve-getParamatPoint e (last l)) 0.001)
222.           (setq l (append l (list (vlax-curve-getEndPoint e))))
223.         )
224.       )
225.       (setq c l)
226.     )
227.     (if (vlax-curve-isClosed e)
228.       (setq l (list (vlax-curve-getStartPoint e)) c l)
229.       (setq l (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e)))
230.     )
231.   )
232.  
233.   (while (cadr l) (setq x (car l) y (cadr l) l (cdr l))
234.     (setq m
235.       (vlax-curve-getPointatDist e
236.         (/ (+ (vlax-curve-getDistatPoint e y) (vlax-curve-getDistAtPoint e x)) 2.)
237.       )
238.     )
239.     (setq d
240.       (abs
241.         (- (vlax-curve-getDistatPoint e y) (vlax-curve-getDistAtPoint e x))
242.       )
243.     )
244.     (setq a
245.       (angle '(0. 0. 0.)
246.         (vlax-curve-getFirstDeriv e (vlax-curve-getParamatPoint e m))
247.       )
248.     )
249.     (setq ta (_makereadable a))
250.  
251.     (setq to (vla-AddText acspc (rtos d) (vlax-3D-point '(0. 0. 0.)) ts))
252.     (vla-put-Alignment to acAlignmentMiddleCenter)
253.     (vla-put-TextAlignmentPoint to (vlax-3D-point (polar m (+ ta (/ pi 2.)) (* 1.1 ts))))
254.     (vla-put-rotation to ta)    
255.   )
256.  
257.   (if (vlax-curve-isclosed e)
258.     (progn
259.       (if (= 1 (length c)) (setq c (append c c)))
260.       (setq d
261.         (+
262.           (setq d1 (vlax-curve-getDistatPoint e (car c)))
263.           (setq d2 (- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) (vlax-curve-getdistatpoint e (last c))))
264.         )
265.       )                  
266.       (setq m
267.         (vlax-curve-getPointatDist e
268.           (if (< d1 (setq da (/ (+ d1 d2) 2.)))
269.             (setq da (- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) (- da d1)))
270.             (setq da (- da d2))
271.           )
272.         )
273.       )
274.       (setq a
275.         (angle '(0. 0. 0.)
276.           (vlax-curve-getFirstDeriv e (vlax-curve-getParamatPoint e m))
277.         )
278.       )
279.       (setq ta (_makereadable a))
280.  
281.       (setq to (vla-AddText acspc (rtos d) (vlax-3D-point '(0. 0. 0.)) ts))
282.       (vla-put-Alignment to acAlignmentMiddleCenter)
283.       (vla-put-TextAlignmentPoint to (vlax-3D-point (polar m (+ ta (/ pi 2.)) (* 1.1 ts))))
284.       (vla-put-rotation to ta)
285.     )
286.   )
287.  
288.   (_EndUndo acdoc)
289.   (princ)
290. )
291.  
292. ;;------------------------------------------------------------;;
293.  
294. (vl-load-com)
295. (princ)
296. (princ "\n:: IntLen.lsp | Version 1.4 | © Lee Mac 2011 www.lee-mac.com ::")
297. (princ "\n:: Type \"IntLen\" or \"IntLenM\" to Invoke ::")
298. (princ)
299.  
300. ;;------------------------------------------------------------;;
301. ;;                         End of File                        ;;
302. ;;------------------------------------------------------------;;
303.  

[PM]

I think that i have to add in the code something like this

Code - Auto/Visual Lisp: [Select]

1. (setq ss (ssget "x" (list (cons 8 "DR_LINES"))))
2.  

Can any one help?

I know that there is an option to select multyple lines with INTLENM but if searching for something faster

Thanks

[BIGAL]

Have you looked at (ssget "F" pts you would pick the white line it will then find all the orange lines and get there intersection point, making a list and sort on dist from end point of white line so in correct order then just do dimension.

After saying all that there is a quickdimension command came across it the other day it was ?? cant remember.

[PM]

Can any one fix it?

Thanks

[BIGAL]

What part of the big hint "quick dimension" did you not understand. Does what you want.

[PM]

Sory BIGAL.What quick dimension. I can not understand?

[BIGAL]

QDIM if you had googled.