Topic: how to fix code can use any select and any 4 lines?

[masao]

Code: [Select]

(defun c:vv3 ( / sel int ent nxt lst rad ss0 ss1 ss2 ss3 ss4 ss5 ss6 ptlist pt1 pt2 pt3 pt4 ptc cempm cenpm2 ang ptm pt5 pt6 pt7 pt8 r p1 p2 p3 p4)

(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cmdecho" "osmode" "peditaccept" "FILLETRAD")))

(defun *error* (msg)

(command-s "ucs" "previous")

(mapcar 'eval e_lst)

(princ "")

)

 (setvar "cmdecho" 0)

(command "_.undo" "_begin")

(setq osm (getvar "osmode"))

(setvar "osmode" 0)

(command "ucs" "world")

(while (= int nil)

  (and (princ "\nSelect select lines:")
       (setq int -1 sel (ssget '((0 . "LINE"))))
       (or (= (sslength sel) 4)
         (progn
           (alert "Must select just 4 line objects!. Try agian")
           (setq int nil)
         );progn
        );or   

       (while (setq int (1+ int) ent (ssname sel int))
         (setq lst (cons ent lst))
         )
       (setq lst (cons (last lst) lst))
       (setq rad (getvar "FILLETRAD"))
       (setvar 'FILLETRAD 0.0)
       (while (setq nxt (cadr lst))
         (command "_.FILLET" (car lst) nxt)
         (setq lst (cdr lst))
         )
       (setvar "FILLETRAD" rad)
       )

);while

  (setq r nil)

  (setq r (getreal "\n radius size:"))

(setvar "peditaccept" 1)

(command "pedit" "m" "p" "" "join" "0" "")

(setq ss1 (entlast))

 (setq ptlist(mapcar 'cdr (vl-remove-if (function (lambda (e) (/= 10 (car e)))) (entget ss1))))

    (setq pt1 (nth 0 ptlist))
    (setq pt2 (nth 1 ptlist))
    (setq pt3 (nth 2 ptlist))
    (setq pt4 (nth 3 ptlist))

(setq ptc (polar pt1 (angle pt1 pt3) (* 0.5 (distance pt1 pt3))))
(setq cenpm (/ (distance PT1 PT2) 2))
(setq cenpm2 (/ (distance PT2 PT3) 2))
(setq ang (angle pt1 pt2))

(setq ptm (polar ptc (+ (* pi 0.5) ang) cenpm2))

(setq pt5 (polar ptm (+ pi ang) cenpm))

(setq pt6 (polar pt5 (+ 0 ang) (distance PT1 PT2)))

(setq pt7 (polar pt6 (+ (* pi 1.5) ang) (distance PT2 PT3)))

(setq pt8 (polar pt7 (+ pi ang) (distance PT1 PT2)))

  (setq dm1 (* (* r 2) 0.33))
  (setq dm2 (* dm1 (sqrt 2)))


 (setq p1 (polar pt5 (+ (* pi 1.75) ang) dm2))

 (setq p2 (polar pt6 (+ (* pi 1.25) ang) dm2))

 (setq p3 (polar pt7 (+ (* pi 0.75) ang) dm2))

 (setq p4 (polar pt8 (+ (* pi 0.25) ang) dm2))

 (command "circle" p1 r)
 (setq ss2 (entlast))
 
 (command "circle" p2 r)
 (setq ss3 (entlast))
 
 (command "circle" p3 r)
 (setq ss4 (entlast))

 (command "circle" p4 r)
 (setq ss5 (entlast))

 (command "region" ss1 "")
 (setq ss0 (entlast))

 (command "region" ss2 "")
 (setq ss2 (entlast))

 (command "region" ss3 "")
 (setq ss3 (entlast))

 (command "region" ss4 "")
 (setq ss4 (entlast))

 (command "region" ss5 "")
 (setq ss5 (entlast))
 
 (command "union" ss0 ss2 ss3 ss4 ss5 "")
 (setq ss6 (entlast))

 (command "explode" ss6)
 
 (command "pedit" "m" "p" "" "join" 0 "")

 (command "ucs" "previous")

 (setvar "osmode" osm)

 (setvar "peditaccept" 0)

(command "_.undo" "_end")

(princ)
)
(princ)
sorry, today i test this lisp can not use on cad2012.

cad2012 use fillet must use shift to extend lines.

there are other ways to select drawing 4 lines to get rectangle?

selcct 4 lines to get 4  intersection than Comparison 4 point angle.←this way can get correct 4 point for rectangle?

last article→https://www.theswamp.org/index.php?topic=58344.0

[kdub_nz]

masao,

You are expecting people to open your drawing and then analyse lisp file(s) and decipher your image to (try to ) determine what your question is.

How about you ask the real question and let people spend time on the solution, rather than on guessing the real question.
The files you posted should be supplimentary to the question.

If we have to quess the question the answers will reflect that.

regards,