Author Topic: 2023/07/05 hi everyone how can i let select lines to reorder lines to fillet?  (Read 1787 times)

0 Members and 1 Guest are viewing this topic.

masao

  • Newt
  • Posts: 97
How to window select 4 lines get intersection point of 4 lines and use 4 point draw a rectangle  and 4 circles.

circle place use diameter multiplied by 0.33 and use rectangle point move inward.

2023/07/05

hi everyone,i found autocad2012 can not use this lisp problem.it's "trimmode" not set 1.

but fillet order problem still hasn't to let fillet order to clockwise or counterclockwise.

how can i let select lines to reorder?(if i select 4 lines once.)

Code: [Select]
(defun c:vv3 (/ osm trimm 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"))

(setq trimm (getvar "trimmode"))

(setvar "trimmode" 1)

(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 "trimmode" trimm)

 (setvar "peditaccept" 0)

(command "_.undo" "_end")

(princ)
)
(princ)
« Last Edit: July 05, 2023, 09:02:18 AM by masao »

ribarm

  • Gator
  • Posts: 3310
  • Marko Ribar, architect
Re: how to get intersection point of 4 lines by window select
« Reply #1 on: June 19, 2023, 04:55:58 PM »
The code is a little unpredictable mostly if lines are off screen, or you don't have parallel like described in pictures... I only joined them into polyline and the other part with circles I leave to someone else...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bound-lins ( / unit ss lins linss ssxl xlins l1x l2x ip ips ce )
  2.  
  3.   (defun unit ( v / d )
  4.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
  5.       (mapcar '(lambda ( x ) (/ x d)) v)
  6.     )
  7.   )
  8.  
  9.   (vl-cmdf "_.UNDO" "_BE")
  10.   (if (setq ss (ssget "_:L" '((0 . "LINE"))))
  11.     (progn
  12.       (setq lins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  13.       (setq ssxl (ssadd))
  14.       (mapcar '(lambda ( x ) (setq xlins (cons (entmakex (list (cons 0 "XLINE") (assoc 10 x) (cons 11 (unit (mapcar '- (cdr (assoc 11 x)) (cdr (assoc 10 x))))))) xlins))) (mapcar 'entget lins))
  15.       (mapcar '(lambda ( x ) (ssadd x ssxl)) xlins)
  16.       (setq linss lins)
  17.       (foreach li1 linss
  18.         (setq linss (vl-remove li1 linss))
  19.         (foreach li2 linss
  20.           (if (setq ip (inters (cdr (assoc 10 (setq l1x (entget li1)))) (cdr (assoc 11 l1x)) (cdr (assoc 10 (setq l2x (entget li2)))) (cdr (assoc 11 l2x)) nil))
  21.             (if (not (vl-some '(lambda ( x ) (equal x ip 1e-6)) ips))
  22.               (setq ips (cons ip ips))
  23.             )
  24.           )
  25.         )
  26.       )
  27.       (setq ips (vl-remove-if '(lambda ( x ) (not (osnap x "_int"))) ips))
  28.       (setq ce (mapcar '/ (apply 'mapcar (cons '+ ips)) (list (length ips) (length ips) (length ips))))
  29.       (vl-cmdf "_.-BOUNDARY" "_A" "_O" "_P" "_I" "_Y" "_B" "_N" ssxl "" "" "_non" (trans ce 0 1) "")
  30.       (mapcar 'entdel lins)
  31.       (mapcar 'entdel xlins)
  32.     )
  33.   )
  34.   (vl-cmdf "_.UNDO" "_E")
  35.   (princ)
  36. )
  37.  

Regards, M.R.
« Last Edit: June 19, 2023, 05:59:23 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Tharwat

  • Swamp Rat
  • Posts: 711
  • Hypersensitive
Re: how to get intersection point of 4 lines by window select
« Reply #2 on: June 19, 2023, 05:47:59 PM »
It could be as simple as this.  :grinwink:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test ( / sel int ent nxt lst rad )
  2.   ;;----------------------------------------------------;;
  3.   ;;    Author : Tharwat Al Choufi                      ;;
  4.   ;; website: https://autolispprograms.wordpress.com    ;;
  5.   ;;----------------------------------------------------;;
  6.   (and (princ "\nSelect lines : ")
  7.        (setq int -1 sel (ssget '((0 . "LINE"))))
  8.        (or (= (sslength sel) 4)
  9.            (alert "Must select just 4 line objects!. Try agian")
  10.            )
  11.        (while (setq int (1+ int) ent (ssname sel int))
  12.          (setq lst (cons ent lst))
  13.          )
  14.        (setq lst (cons (last lst) lst))
  15.        (setq rad (getvar 'FILLETRAD))
  16.        (setvar 'FILLETRAD 0.0)
  17.        (while (setq nxt (cadr lst))
  18.          (command "_.FILLET" (car lst) nxt)
  19.          (setq lst (cdr lst))
  20.          )
  21.        (setvar 'FILLETRAD rad)
  22.        )
  23.   (princ)
  24.   )
Then you can join the lines to be one polyline to make the work easier when adding circles on corners .

masao

  • Newt
  • Posts: 97
Re: how to get intersection point of 4 lines by window select
« Reply #3 on: June 19, 2023, 06:37:25 PM »
The code is a little unpredictable mostly if lines are off screen, or you don't have parallel like described in pictures... I only joined them into polyline and the other part with circles I leave to someone else...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bound-lins ( / unit ss lins linss ssxl xlins l1x l2x ip ips ce )
  2.  
  3.   (defun unit ( v / d )
  4.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
  5.       (mapcar '(lambda ( x ) (/ x d)) v)
  6.     )
  7.   )
  8.  
  9.   (vl-cmdf "_.UNDO" "_BE")
  10.   (if (setq ss (ssget "_:L" '((0 . "LINE"))))
  11.     (progn
  12.       (setq lins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  13.       (setq ssxl (ssadd))
  14.       (mapcar '(lambda ( x ) (setq xlins (cons (entmakex (list (cons 0 "XLINE") (assoc 10 x) (cons 11 (unit (mapcar '- (cdr (assoc 11 x)) (cdr (assoc 10 x))))))) xlins))) (mapcar 'entget lins))
  15.       (mapcar '(lambda ( x ) (ssadd x ssxl)) xlins)
  16.       (setq linss lins)
  17.       (foreach li1 linss
  18.         (setq linss (vl-remove li1 linss))
  19.         (foreach li2 linss
  20.           (if (setq ip (inters (cdr (assoc 10 (setq l1x (entget li1)))) (cdr (assoc 11 l1x)) (cdr (assoc 10 (setq l2x (entget li2)))) (cdr (assoc 11 l2x)) nil))
  21.             (if (not (vl-some '(lambda ( x ) (equal x ip 1e-6)) ips))
  22.               (setq ips (cons ip ips))
  23.             )
  24.           )
  25.         )
  26.       )
  27.       (setq ips (vl-remove-if '(lambda ( x ) (not (osnap x "_int"))) ips))
  28.       (setq ce (mapcar '/ (apply 'mapcar (cons '+ ips)) (list (length ips) (length ips) (length ips))))
  29.       (vl-cmdf "_.-BOUNDARY" "_A" "_O" "_P" "_I" "_Y" "_B" "_N" ssxl "" "" "_non" (trans ce 0 1) "")
  30.       (mapcar 'entdel lins)
  31.       (mapcar 'entdel xlins)
  32.     )
  33.   )
  34.   (vl-cmdf "_.UNDO" "_E")
  35.   (princ)
  36. )
  37.  

Regards, M.R.

thank you but this function i cant use it. (→lentityp nil)

masao

  • Newt
  • Posts: 97
Re: how to get intersection point of 4 lines by window select
« Reply #4 on: June 19, 2023, 06:42:15 PM »
It could be as simple as this.  :grinwink:
Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test ( / sel int ent nxt lst rad )
  2.   ;;----------------------------------------------------;;
  3.   ;;    Author : Tharwat Al Choufi                      ;;
  4.   ;; website: https://autolispprograms.wordpress.com    ;;
  5.   ;;----------------------------------------------------;;
  6.   (and (princ "\nSelect lines : ")
  7.        (setq int -1 sel (ssget '((0 . "LINE"))))
  8.        (or (= (sslength sel) 4)
  9.            (alert "Must select just 4 line objects!. Try agian")
  10.            )
  11.        (while (setq int (1+ int) ent (ssname sel int))
  12.          (setq lst (cons ent lst))
  13.          )
  14.        (setq lst (cons (last lst) lst))
  15.        (setq rad (getvar 'FILLETRAD))
  16.        (setvar 'FILLETRAD 0.0)
  17.        (while (setq nxt (cadr lst))
  18.          (command "_.FILLET" (car lst) nxt)
  19.          (setq lst (cdr lst))
  20.          )
  21.        (setvar 'FILLETRAD rad)
  22.        )
  23.   (princ)
  24.   )
Then you can join the lines to be one polyline to make the work easier when adding circles on corners .

thank you this function can help me,i can join line to use lwpolyline lisp draw circle.

ribarm

  • Gator
  • Posts: 3310
  • Marko Ribar, architect
Re: how to get intersection point of 4 lines by window select
« Reply #5 on: June 19, 2023, 09:08:44 PM »
The code is a little unpredictable mostly if lines are off screen, or you don't have parallel like described in pictures... I only joined them into polyline and the other part with circles I leave to someone else...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bound-lins ( / unit ss lins linss ssxl xlins l1x l2x ip ips ce )
  2.  
  3.   (defun unit ( v / d )
  4.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
  5.       (mapcar '(lambda ( x ) (/ x d)) v)
  6.     )
  7.   )
  8.  
  9.   (vl-cmdf "_.UNDO" "_BE")
  10.   (if (setq ss (ssget "_:L" '((0 . "LINE"))))
  11.     (progn
  12.       (setq lins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  13.       (setq ssxl (ssadd))
  14.       (mapcar '(lambda ( x ) (setq xlins (cons (entmakex (list (cons 0 "XLINE") (assoc 10 x) (cons 11 (unit (mapcar '- (cdr (assoc 11 x)) (cdr (assoc 10 x))))))) xlins))) (mapcar 'entget lins))
  15.       (mapcar '(lambda ( x ) (ssadd x ssxl)) xlins)
  16.       (setq linss lins)
  17.       (foreach li1 linss
  18.         (setq linss (vl-remove li1 linss))
  19.         (foreach li2 linss
  20.           (if (setq ip (inters (cdr (assoc 10 (setq l1x (entget li1)))) (cdr (assoc 11 l1x)) (cdr (assoc 10 (setq l2x (entget li2)))) (cdr (assoc 11 l2x)) nil))
  21.             (if (not (vl-some '(lambda ( x ) (equal x ip 1e-6)) ips))
  22.               (setq ips (cons ip ips))
  23.             )
  24.           )
  25.         )
  26.       )
  27.       (setq ips (vl-remove-if '(lambda ( x ) (not (osnap x "_int"))) ips))
  28.       (setq ce (mapcar '/ (apply 'mapcar (cons '+ ips)) (list (length ips) (length ips) (length ips))))
  29.       (vl-cmdf "_.-BOUNDARY" "_A" "_O" "_P" "_I" "_Y" "_B" "_N" ssxl "" "" "_non" (trans ce 0 1) "")
  30.       (mapcar 'entdel lins)
  31.       (mapcar 'entdel xlins)
  32.     )
  33.   )
  34.   (vl-cmdf "_.UNDO" "_E")
  35.   (princ)
  36. )
  37.  

Regards, M.R.

thank you but this function i cant use it. (→lentityp nil)

Just make sure that when you select lines, you stay in visible portion of lines intersections...
It should work, but unforteunately I don't know how to overcome this visibility on screen issue...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

BIGAL

  • Swamp Rat
  • Posts: 1436
  • 40 + years of using Autocad
Re: how to get intersection point of 4 lines by window select
« Reply #6 on: June 19, 2023, 11:44:51 PM »
just a dumb question why are you not drawing rectangs ? Can enter leg sizes and angle, then add circles all in one go. To me a better way.

« Last Edit: June 19, 2023, 11:49:39 PM by BIGAL »
A man who never made a mistake never made anything

ribarm

  • Gator
  • Posts: 3310
  • Marko Ribar, architect
Re: how to get intersection point of 4 lines by window select
« Reply #7 on: June 20, 2023, 07:09:24 AM »
Here is my revision - overcommed issue with not visible lines...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:bound-lins ( / unit collinear-p mid MR:ConvexHull-ptsonHull car-sort ss lins linss ssxl xlins l1x l2x lix ip ips midpts mp ce ocs )
  2.  
  3.   (defun unit ( v / d )
  4.     (if (not (equal (setq d (distance '(0.0 0.0 0.0) v)) 0.0 1e-8))
  5.       (mapcar '(lambda ( x ) (/ x d)) v)
  6.     )
  7.   )
  8.  
  9.   (defun collinear-p ( p1 p p2 )
  10.     (equal (distance p1 p2) (+ (distance p1 p) (distance p p2)) 1e-6)
  11.   )
  12.  
  13.   (defun mid ( p1 p2 )
  14.     (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2)
  15.   )
  16.  
  17.   ;; Convex Hull  -  Lee Mac
  18.   ;; Implements the Graham Scan Algorithm to return the Convex Hull of a list of points.
  19.   ;; Mod by M.R.  -  uses (car-sort) sub...
  20.  
  21.   (defun MR:ConvexHull-ptsonHull ( lst / ch p0 lstl )
  22.     (cond
  23.       ( (< (length lst) 4) (vl-sort lst (function (lambda ( a b ) (if (= (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b)))))) )
  24.       ( (setq p0 (car lst))
  25.         (foreach p1 (cdr lst)
  26.           (if (or (< (cadr p1) (cadr p0)) (and (= (cadr p1) (cadr p0)) (< (car p1) (car p0))))
  27.             (setq p0 p1)
  28.           )
  29.         )
  30.         (setq lst (vl-remove p0 lst))
  31.         (setq lst (append (list p0) lst))
  32.         (setq lst
  33.           (vl-sort lst
  34.             (function
  35.               (lambda ( a b / c d )
  36.                 (if (or (equal (setq c (angle p0 a)) (setq d (angle p0 b)) 1e-8) (and (or (equal c 0.0 1e-8) (equal c (* 2 pi) 1e-8)) (or (equal d 0.0 1e-8) (equal d (* 2 pi) 1e-8))))
  37.                   (< (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))
  38.                   (< c d)
  39.                 )
  40.               )
  41.             )
  42.           )
  43.         )
  44.         (setq lstl (vl-remove-if-not (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  45.         (setq lst (vl-remove-if (function (lambda ( x ) (equal (angle p0 (last lst)) (angle p0 x) 1e-8))) lst))
  46.         (setq lstl (vl-sort lstl (function (lambda ( a b ) (> (distance (list (car p0) (cadr p0)) a) (distance (list (car p0) (cadr p0)) b))))))
  47.         (setq lst (append lst lstl))
  48.         (setq ch (list (cadr lst) (car lst)))
  49.         (foreach pt (cddr lst)
  50.           (if (equal pt (last lst))
  51.             (setq ch (cons pt ch))
  52.             (if (or (equal (angle (car ch) pt) (car-sort (mapcar (function (lambda ( x ) (angle (car ch) x))) (member pt lst)) (function <)) 1e-6) (equal (distance pt (cadr ch)) (+ (distance pt (car ch)) (distance (car ch) (cadr ch))) 1e-6))
  53.               (setq ch (cons pt ch))
  54.             )
  55.           )
  56.         )
  57.         (reverse ch)
  58.       )
  59.     )
  60.   )
  61.  
  62.   (defun car-sort ( lst cmp / rtn )
  63.     (setq rtn (car lst))
  64.     (foreach itm (cdr lst)
  65.       (if (apply cmp (list itm rtn))
  66.         (setq rtn itm)
  67.       )
  68.     )
  69.     rtn
  70.   )
  71.  
  72.   (vl-cmdf "_.UNDO" "_BE")
  73.   (if (setq ss (ssget "_:L" '((0 . "LINE"))))
  74.     (progn
  75.       (setq lins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  76.       (setq ssxl (ssadd))
  77.       (mapcar '(lambda ( x ) (setq xlins (cons (entmakex (list (cons 0 "XLINE") (assoc 10 x) (cons 11 (unit (mapcar '- (cdr (assoc 11 x)) (cdr (assoc 10 x))))))) xlins))) (mapcar 'entget lins))
  78.       (mapcar '(lambda ( x ) (ssadd x ssxl)) xlins)
  79.       (setq linss lins)
  80.       (foreach li1 linss
  81.         (setq linss (vl-remove li1 linss))
  82.         (foreach li2 linss
  83.           (if (setq ip (inters (cdr (assoc 10 (setq l1x (entget li1)))) (cdr (assoc 11 l1x)) (cdr (assoc 10 (setq l2x (entget li2)))) (cdr (assoc 11 l2x)) nil))
  84.             (if (not (vl-some '(lambda ( x ) (equal x ip 1e-6)) ips))
  85.               (setq ips (cons ip ips))
  86.             )
  87.           )
  88.         )
  89.       )
  90.       (foreach li lins
  91.         (setq midpts (cons (mid (cdr (assoc 10 (setq lix (entget li)))) (cdr (assoc 11 lix))) midpts))
  92.       )
  93.       (foreach ip ips
  94.         (foreach a (vl-remove ip ips)
  95.           (foreach b (vl-remove a (vl-remove ip ips))
  96.             (cond
  97.               ( (and (collinear-p a b ip) (setq mp (vl-some '(lambda ( x ) (if (collinear-p a x ip) x)) midpts)))
  98.                 (if (< (distance a mp) (distance mp ip))
  99.                   (setq ips (vl-remove ip ips))
  100.                   (setq ips (vl-remove a ips))
  101.                 )
  102.               )
  103.               ( (and (collinear-p b a ip) (setq mp (vl-some '(lambda ( x ) (if (collinear-p b x ip) x)) midpts)))
  104.                 (if (< (distance b mp) (distance mp ip))
  105.                   (setq ips (vl-remove ip ips))
  106.                   (setq ips (vl-remove b ips))
  107.                 )
  108.               )
  109.               ( (and (collinear-p ip a b) (setq mp (vl-some '(lambda ( x ) (if (collinear-p ip x b) x)) midpts)))
  110.                 (if (> (distance ip mp) (distance mp b))
  111.                   (setq ips (vl-remove ip ips))
  112.                   (setq ips (vl-remove b ips))
  113.                 )
  114.               )
  115.               ( (and (collinear-p ip b a) (setq mp (vl-some '(lambda ( x ) (if (collinear-p ip x a) x)) midpts)))
  116.                 (if (> (distance ip mp) (distance mp a))
  117.                   (setq ips (vl-remove ip ips))
  118.                   (setq ips (vl-remove a ips))
  119.                 )
  120.               )
  121.             )
  122.           )
  123.         )
  124.       )
  125.       ;(setq ce (mapcar '/ (apply 'mapcar (cons '+ ips)) (list (length ips) (length ips) (length ips))))
  126.       ;(vl-cmdf "_.-BOUNDARY" "_A" "_O" "_P" "_I" "_Y" "_B" "_N" ssxl "" "" "_non" (trans ce 0 1) "")
  127.       (setq ips (mapcar '(lambda ( p ) (trans p 0 1)) ips))
  128.       (setq ips (MR:ConvexHull-ptsonHull ips))
  129.       (setq ocs (trans (list 0.0 0.0 1.0) 1 0 t))
  130.       (entmake
  131.         (append
  132.           (list
  133.             (cons 0 "LWPOLYLINE")
  134.             (cons 100 "AcDbEntity")
  135.             (cons 100 "AcDbPolyline")
  136.             (cons 90 4)
  137.             (cons 70 (1+ (* 128 (getvar 'plinegen))))
  138.             (cons 38 (caddr (trans (car ips) 1 ocs)))
  139.           )
  140.           (mapcar '(lambda ( x ) (cons 10 (trans x 1 ocs))) ips)
  141.           (list (cons 210 ocs))
  142.         )
  143.       )
  144.       (mapcar '(lambda ( x ) (if (not (vlax-erased-p x)) (entdel x))) lins)
  145.       (mapcar '(lambda ( x ) (if (not (vlax-erased-p x)) (entdel x))) xlins)
  146.     )
  147.   )
  148.   (vl-cmdf "_.UNDO" "_E")
  149.   (princ)
  150. )
  151.  

Regards, M.R.
« Last Edit: June 20, 2023, 11:10:26 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

masao

  • Newt
  • Posts: 97
Re: how to get intersection point of 4 lines by window select
« Reply #8 on: June 20, 2023, 08:47:23 AM »
ok i try to modify lisp can use thanks all.

and i have this question don't know,this week have time i use picture post it.

thinks

https://www.theswamp.org/index.php?topic=58259.msg614456#msg614456

ribarm

  • Gator
  • Posts: 3310
  • Marko Ribar, architect
Re: how to get intersection point of 4 lines by window select
« Reply #9 on: June 20, 2023, 09:51:57 AM »
With this line called from error handler, you are doing nothing :
Code: [Select]
(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cmdecho" "osmode" "peditaccept" "filletrad")))
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

masao

  • Newt
  • Posts: 97
Re: how to get intersection point of 4 lines by window select
« Reply #10 on: June 20, 2023, 11:11:47 AM »
With this line called from error handler, you are doing nothing :
Code: [Select]
(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cmdecho" "osmode" "peditaccept" "filletrad")))

What mean? But I try to use,can draw finish. I can’t use computer to try now.

masao

  • Newt
  • Posts: 97
Re: how to get intersection point of 4 lines by window select
« Reply #11 on: June 22, 2023, 12:37:22 AM »
With this line called from error handler, you are doing nothing :
Code: [Select]
(setq e_lst (mapcar (function (lambda (n) (list 'setvar n (getvar n)))) '("cmdecho" "osmode" "peditaccept" "filletrad")))

OK i knew,now can do it.if use same 4 lines complete lisp,than back to not use lisp yet 4 lines.Repeat use this lisp have some bug in fillet lines seldom.

masao

  • Newt
  • Posts: 97
Re: 2023/07/05 hi everyone how can i let select lines to reorder?
« Reply #12 on: July 05, 2023, 08:33:02 AM »
How to window select 4 lines get intersection point of 4 lines and use 4 point draw a rectangle  and 4 circles.

circle place use diameter multiplied by 0.33 and use rectangle point move inward.

2023/07/05

hi everyone,i found autocad2012 can not use this lisp problem.it's "trimmode" not set 1.

but fillet order problem still hasn't to let fillet order to clockwise or counterclockwise.

Code: [Select]
(defun c:vv3 (/ osm trimm 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"))

(setq trimm (getvar "trimmode"))

(setvar "trimmode" 1)

(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 "trimmode" trimm)

 (setvar "peditaccept" 0)

(command "_.undo" "_end")

(princ)
)
(princ)

hi everyone how can i let select lines to reorder?(if i select 4 lines once.)
« Last Edit: July 05, 2023, 08:36:43 AM by masao »