Topic: how to batch connect gap with arc by window selectiion

[meja]

although using arc command can connect two end points ，but it is so slow，I want to only use window select do that , Anyone help？
my code，just creat one arc every time

Code: [Select]

(defun c:tt()
  (setvar "CMDECHO" 0)
  (setq  p1 (getpoint "\n第一点：")
  p2 (getpoint p1 "\n第二点：")
  ANG (angle p1 p2)
  po (MAPCAR '(lambda (X Y ) (* (+ X Y) 0.5))  P1 P2)
  )
 (command "arc" "c" po p2 p1 "")
)


[BIGAL]

No gap to start with just break the line with a jump over. I know I have an Arc or a 2 line solution trying to find it.

Found the break part. Will keep looking else say tomorrow will use what I have and post a solution.

[masao]

我沒辦法知道您圖面會遇到的狀況，比較萬用的方式就是抓點或選擇線條

但是弧的角度不同所畫出的圖形會不一樣，可能需要進一步了解您會遇到的圖面狀況去做修正

若有更好的辦法歡迎分享交流，謝謝

[meja]

我沒辦法知道您圖面會遇到的狀況，比較萬用的方式就是抓點或選擇線條

但是弧的角度不同所畫出的圖形會不一樣，可能需要進一步了解您會遇到的圖面狀況去做修正

若有更好的辦法歡迎分享交流，謝謝

如何得到最近两点的选择集论坛有大神是有判定方法的，至于角度，用ucs判定就好，最好就是用polar这种极坐标的

[ribarm]

Untested and debugging is up to you... At first glance it looks well to my eyes...

Code - Auto/Visual Lisp: [Select]

1. (defun c:jump-gaps-with-arcs ( / *error* collinear-p nearestpts osm cmd ss lins lix lil neapts )
2.  
3.   (defun *error* ( m )
4.     (if cmd
5.       (setvar "cmdecho" cmd)
6.     )
7.     (if osm
8.       (setvar "osmode" osm)
9.     )
10.     (if m
11.       (prompt m)
12.     )
13.     (princ)
14.   )
15.  
16.   (defun collinear-p ( p1 p p2 )
17.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
18.   )
19.  
20.   (defun nearestpts ( p1 p2 p3 p4 / dl dmin pos )
21.     (setq dl (list (distance p1 p2) (distance p1 p3) (distance p1 p4) (distance p2 p3) (distance p2 p4) (distance p3 p4)))
22.     (setq dmin (apply 'min dl))
23.     (setq pos (vl-position dmin dl))
24.     (cond
25.       ( (= pos 0)
26.         (list p1 p2)
27.       )
28.       ( (= pos 1)
29.         (list p1 p3)
30.       )
31.       ( (= pos 2)
32.         (list p1 p4)
33.       )
34.       ( (= pos 3)
35.         (list p2 p3)
36.       )
37.       ( (= pos 4)
38.         (list p2 p4)
39.       )
40.       ( t
41.         (list p3 p4)
42.       )
43.     )
44.   )
45.  
46.   (setq osm (getvar "osmode"))
47.   (setvar "osmode" 0)
48.   (setq cmd (getvar "cmdecho"))
49.   (setvar "cmdecho" 0)
50.   (command "_.undo" "_begin")
51.   (prompt "\nSelect only gapped LINES...")
52.   (if (setq ss (ssget '((0 . "LINE"))))
53.     (progn
54.       (setq lins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
55.       (foreach li lins
56.         (setq lil (cons (list (trans (cdr (assoc 10 (setq lix (entget li)))) 0 1) (trans (cdr (assoc 11 lix)) 0 1)) lil))
57.       )
58.       (foreach li1 lil
59.         (setq lil (vl-remove li1 lil))
60.         (foreach li2 lil
61.           (if (and (collinear-p (car li1) (cadr li1) (car li2)) (collinear-p (car li1) (cadr li1) (cadr li2)))
62.             (progn
63.               (setq neapts (nearestpts (car li1) (cadr li1) (car li2) (cadr li2)))
64.               (if (and (< (cadar neapts) (cadadr neapts)) (> (caar neapts) (caadr neapts)))
65.                 (vl-cmdf "_.arc" "_c" "_non" (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car neapts) (cadr neapts)) "_non" (car neapts)"_non" (cadr neapts))
66.                 (vl-cmdf "_.arc" "_c" "_non" (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car neapts) (cadr neapts)) "_non" (cadr neapts) "_non" (car neapts))
67.               )
68.             )
69.           )
70.         )
71.       )
72.     )
73.   )
74.   (command "_.undo" "_end")
75.   (*error* nil)
76. )
77.  

Regards, M.R.

[masao]

我沒辦法知道您圖面會遇到的狀況，比較萬用的方式就是抓點或選擇線條

但是弧的角度不同所畫出的圖形會不一樣，可能需要進一步了解您會遇到的圖面狀況去做修正

若有更好的辦法歡迎分享交流，謝謝

如何得到最近两点的选择集论坛有大神是有判定方法的，至于角度，用ucs判定就好，最好就是用polar这种极坐标的

角度可能沒這麼好判定，如果您的弧都要往上的話，用窗選後要先將點所有點聚集後，判斷哪些點是用在同一條線上，然後角度抓出來後，還要確定點選的方向，用arc點選順序不同弧的方向就不一樣，當然也要一照您會遇到的圖面而定，如果只是單純的左右那就很容易，若還要加上上下方向就更複雜了，如果有方法可以分享看看

[BIGAL]

Try thism breaks the line so no gap required. Can set radius if required set to 4 at moment.

Code: [Select]

; Break p/lines at intersection
; By AlanH April 2023

(defun c:wow ( / ss1 ss2 rad obj2 intpt obj intpts pt1 pt2 )
(setq oldsnap (getvar 'osmode))
(prompt "Select cut line ")
(setq ss1 (ssget "_+.:E:S" '((0 . "LWPOLYLINE,LINE"))))
(princ "\n")
(prompt "Select break line ")
(setq ss2 (ssget "_+.:E:S" '((0 . "LWPOLYLINE,LINE"))))
(setvar 'osmode 0)
(setq rad 4)
(repeat (setq x (sslength ss1))
(setq obj1 (vlax-ename->vla-object (ssname ss1 (setq x (- x 1)))))
  (repeat (setq y (sslength ss2))
    (setq obj2 (vlax-ename->vla-object (ssname ss2 (setq y (- y 1)))))
    (setq intpt (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
    (if intpt
    (progn
     (command "circle" intpt rad)
     (setq obj (vlax-ename->vla-object (entlast)))
     (setq intpts (vlax-invoke obj2 'intersectWith obj acExtendThisEntity))
     (entdel (entlast))
(setq pt1 (list (car intpts)(cadr intpts)))
(setq pt2 (list (nth 3 intpts)(nth 4 intpts)))
     (command "break" pt1 pt2)
(command "arc" "S" pt1 "E" pt2 "R" rad)
    )
    )
  )
)
(setvar 'osmode oldsnap)
(princ)
)
(c:wow)


[meja]

我沒辦法知道您圖面會遇到的狀況，比較萬用的方式就是抓點或選擇線條

但是弧的角度不同所畫出的圖形會不一樣，可能需要進一步了解您會遇到的圖面狀況去做修正

若有更好的辦法歡迎分享交流，謝謝

如何得到最近两点的选择集论坛有大神是有判定方法的，至于角度，用ucs判定就好，最好就是用polar这种极坐标的

角度可能沒這麼好判定，如果您的弧都要往上的話，用窗選後要先將點所有點聚集後，判斷哪些點是用在同一條線上，然後角度抓出來後，還要確定點選的方向，用arc點選順序不同弧的方向就不一樣，當然也要一照您會遇到的圖面而定，如果只是單純的左右那就很容易，若還要加上上下方向就更複雜了，如果有方法可以分享看看

可以比较列表两点的X值进行判断弧的上下的

[meja]

Untested and debugging is up to you... At first glance it looks well to my eyes...

Code - Auto/Visual Lisp: [Select]

1. (defun c:jump-gaps-with-arcs ( / *error* collinear-p nearestpts osm cmd ss lins lix lil neapts )
2.  
3.   (defun *error* ( m )
4.     (if cmd
5.       (setvar "cmdecho" cmd)
6.     )
7.     (if osm
8.       (setvar "osmode" osm)
9.     )
10.     (if m
11.       (prompt m)
12.     )
13.     (princ)
14.   )
15.  
16.   (defun collinear-p ( p1 p p2 )
17.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
18.   )
19.  
20.   (defun nearestpts ( p1 p2 p3 p4 / dl dmin pos )
21.     (setq dl (list (distance p1 p2) (distance p1 p3) (distance p1 p4) (distance p2 p3) (distance p2 p4) (distance p3 p4)))
22.     (setq dmin (apply 'min dl))
23.     (setq pos (vl-position dmin dl))
24.     (cond
25.       ( (= pos 0)
26.         (list p1 p2)
27.       )
28.       ( (= pos 1)
29.         (list p1 p3)
30.       )
31.       ( (= pos 2)
32.         (list p1 p4)
33.       )
34.       ( (= pos 3)
35.         (list p2 p3)
36.       )
37.       ( (= pos 4)
38.         (list p2 p4)
39.       )
40.       ( t
41.         (list p3 p4)
42.       )
43.     )
44.   )
45.  
46.   (setq osm (getvar "osmode"))
47.   (setvar "osmode" 0)
48.   (setq cmd (getvar "cmdecho"))
49.   (setvar "cmdecho" 0)
50.   (command "_.undo" "_begin")
51.   (prompt "\nSelect only gapped LINES...")
52.   (if (setq ss (ssget '((0 . "LINE"))))
53.     (progn
54.       (setq lins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
55.       (foreach li lins
56.         (setq lil (cons (list (trans (cdr (assoc 10 (setq lix (entget li)))) 0 1) (trans (cdr (assoc 11 lix)) 0 1)) lil))
57.       )
58.       (foreach li1 lil
59.         (setq lil (vl-remove li1 lil))
60.         (foreach li2 lil
61.           (if (and (collinear-p (car li1) (cadr li1) (car li2)) (collinear-p (car li1) (cadr li1) (cadr li2)))
62.             (progn
63.               (setq neapts (nearestpts (car li1) (cadr li1) (car li2) (cadr li2)))
64.               (if (and (< (cadar neapts) (cadadr neapts)) (> (caar neapts) (caadr neapts)))
65.                 (vl-cmdf "_.arc" "_c" "_non" (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car neapts) (cadr neapts)) "_non" (car neapts)"_non" (cadr neapts))
66.                 (vl-cmdf "_.arc" "_c" "_non" (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car neapts) (cadr neapts)) "_non" (cadr neapts) "_non" (car neapts))
67.               )
68.             )
69.           )
70.         )
71.       )
72.     )
73.   )
74.   (command "_.undo" "_end")
75.   (*error* nil)
76. )
77.  

Regards, M.R.

wow, you did it!!! It is i wanted.

[meja]

Try thism breaks the line so no gap required. Can set radius if required set to 4 at moment.

Code: [Select]

; Break p/lines at intersection
; By AlanH April 2023

(defun c:wow ( / ss1 ss2 rad obj2 intpt obj intpts pt1 pt2 )
(setq oldsnap (getvar 'osmode))
(prompt "Select cut line ")
(setq ss1 (ssget "_+.:E:S" '((0 . "LWPOLYLINE,LINE"))))
(princ "\n")
(prompt "Select break line ")
(setq ss2 (ssget "_+.:E:S" '((0 . "LWPOLYLINE,LINE"))))
(setvar 'osmode 0)
(setq rad 4)
(repeat (setq x (sslength ss1))
(setq obj1 (vlax-ename->vla-object (ssname ss1 (setq x (- x 1)))))
  (repeat (setq y (sslength ss2))
    (setq obj2 (vlax-ename->vla-object (ssname ss2 (setq y (- y 1)))))
    (setq intpt (vlax-invoke obj2 'intersectWith obj1 acExtendThisEntity))
    (if intpt
    (progn
     (command "circle" intpt rad)
     (setq obj (vlax-ename->vla-object (entlast)))
     (setq intpts (vlax-invoke obj2 'intersectWith obj acExtendThisEntity))
     (entdel (entlast))
(setq pt1 (list (car intpts)(cadr intpts)))
(setq pt2 (list (nth 3 intpts)(nth 4 intpts)))
     (command "break" pt1 pt2)
(command "arc" "S" pt1 "E" pt2 "R" rad)
    )
    )
  )
)
(setvar 'osmode oldsnap)
(princ)
)
(c:wow)


It is very useful code,thank for your help