Topic: Why is this lisp count start point of 2 lines as one point?

[HasanCAD]

attached snapshop for the result no. 1 has 2 lines
The code

Code - Auto/Visual Lisp: [Select]

1. (defun c:RVC ( / *acad arc clyr doc gp gp1 i obj objs ortmd
2.                p1 p1x p1y p2 p2x p2y p3 p4 p5 p5x p5y ptlist
3.                sp spc tmp ts)
4.   (vl-load-com)
5.   (setq doc (vla-get-ActiveDocument (setq *acad (vlax-get-Acad-Object)))
6.         spc (if (zerop (vla-get-activespace doc))
7.               (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc))
8.               (vla-get-modelspace doc)))
9.  
10.   (setq arc  500)
11.   (setq gp (getpoint "\nPick gathering porvcint"))
12.   (setq gp (trans gp 1 0))
13.   (setq ts (getvar 'TEXTSIZE))
14.   (setvar 'TEXTSIZE 250)
15.   (setq sp (getvar 'TEXTSIZE))
16.   (setq i -1)
17.    
18.   (while T
19.     (if (and (setq p1 (getpoint "\nPick first corner"))
20.              (setq p1 (trans p1 1 0 ))
21.              (setq ortmd (getvar "orthomode"))
22.              (setvar "orthomode" 0)
23.              (setq p2 (getcorner p1 "\nPick second corner"))
24.              (setq p2 (trans p2 1 0 ))
25.              (setvar "orthomode" ortmd)
26.              )
27.       (progn
28.         (setq clyr (getvar "clayer"))
29.         (vl-cmdf "_.LAYER" "MAKE" "Defpoints" "")
30.         (setvar "clayer" clyr)
31.         (setq p1X (min (nth 0 p1) (nth 0 p2))
32.               p1Y (min (nth 1 p1) (nth 1 p2))
33.               p2X (max (nth 0 p1) (nth 0 p2))
34.               p2Y (max (nth 1 p1) (nth 1 p2))
35.               )
36.         (setq p1 (list p1X p1Y 0)
37.               p2 (list p2X p2Y 0)
38.               p3 (list p2X p1Y 0)
39.               p4 (list p1X p2Y 0)
40.               ptlist (list p1 p3 p2 p4)
41.               ptlist (apply 'append ptlist)
42.               )
43.         (setq tmp (vlax-make-safearray vlax-vbDouble (cons 0 (- (length ptlist) 1))))
44.         (vlax-safearray-fill tmp ptlist)
45.  
46.         (setq obj (vla-addPolyline spc tmp))
47.         (vla-put-closed obj :vlax-true)
48.  
49.         (vl-cmdf "_.Revcloud" "A" arc arc "" (entlast) "NO")
50.         (setq obj (vlax-ename->vla-object (entlast)))
51.         (setq objs (vla-put-layer obj "Defpoints"))
52.         (setq objs (vla-put-color obj 256))
53.  
54.         (if (< 0 (nth 0 p1)) (setq p5x (nth 0 p1)) (setq p5x (nth 0 p2)))
55.         (if (< 0 (nth 1 p1)) (setq p5y (nth 1 p1)) (setq p5y (nth 1 p4)))
56.  
57.         (setq p5 (kjk_nearest gp (list p1 p2 p3 p4 )))
58.         (setq gp1 (polar gp (* 1.5 pi) (* (setq i (1+ i)) (* sp 2))))
59.  
60.         (vl-cmdf "_.LINE" gp1 p5 "")
61.         (setq obj (vlax-ename->vla-object (entlast)))
62.         (setq objs (vla-put-layer obj "Defpoints"))
63.         (setq objs (vla-put-color obj 256))
64.         (setq objs (vla-put-linetype obj "Continuous"))
65.  
66.         (setq obj (vla-addtext spc (strcat (itoa (1+ i)) " - ") (vlax-3D-point gp1) sp))
67.         (setq objs (vla-put-layer obj "Defpoints"))
68.         (setq objs (vla-put-color obj 256))
69.        
70.         )))
71.   (setvar 'TEXTSIZE ts)
72.   )
73. (defun kjk_nearest (pt1 ptlist / tpt nearest)
74.   (foreach tpt ptlist (if tpt (setq nearest tpt)))
75.   (foreach tpt ptlist (if tpt (if (< (distance tpt pt1) (distance pt1 nearest)) (setq nearest tpt))))
76.   nearest
77. )
78.  

Thanks in advance

[CAB]

Without trying the lisp, Turn the osnaps off.

[HasanCAD]

Thanks CAB
Working perfect