Polyline and Circle to one polyline

Code Red > AutoLISP (Vanilla / Visual)

(1/4) > >>

Coder:
Hello guys.

I am working now with a new project that requires to deal with polylines all the time.

I would like to specify point on Polyline and create or reshape the polyline with a circle with diameter as variable like this:

--- Code: ---(setq pot (getpoint "specify point on polyline to reshape:"))
(setq diamter (getreal "Diamter of circle please:"))

--- End code ---

Thank you in advance.

Before and After

David Bethel:
This doable but a complex routine.

Basically having to insert vertices and bulges into an existing entity definition multiple times.

You would also need to specify the direction of the center in relation to the pline segment

Coder:
Thank you David for your inputs.

I am happy that it is doable and the direction of circle is not that important.
Can you please give any example ?

Thanks.

ribarm:
Not exactly what you're looking for, but it's close to it... And I am not sure if your example is actually possible to make with LWPOLYLINE...

--- Code - Auto/Visual Lisp: ---(defun c:lwcitanli ( / p1 p2 li ci gr p pp r c cix ) (vl-load-com) (setq p1 (getpoint "\nPick or specify first point : ")) (setq p2 (getpoint p1 "\nPick or specify second point : ")) (setq li (entmakex (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p2 1 0)) '(62 . 1)))) (setq ci (entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") '(10 0.0 0.0 0.0) '(40 . 0.0) '(62 . 1)))) (while (/= 3 (car (setq gr (grread t)))) (setq p (trans (cadr gr) 1 0)) (if (setq pp (vlax-curve-getclosestpointto li p)) (progn (setq r (/ (distance p pp) 2.0)) (setq c (mapcar '/ (mapcar '+ p pp) (list 2.0 2.0 2.0))) (setq cix (list (cons -1 ci) (cons 10 c) (cons 40 r))) (entupd (cdr (assoc -1 (entmod cix)))) ) ) ) (entdel li) (entdel ci) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 5) (cons 70 (* (getvar 'plinegen) 128)) '(38 . 0.0) (cons 10 (trans p1 1 0)) (cons 10 pp) (cons 42 1.0) (cons 10 p) (cons 42 1.0) (cons 10 pp) (cons 10 (trans p2 1 0)) (list 210 0.0 0.0 1.0) '(62 . 3) ) ) (princ))

ribarm:
I still stay with my statement that that's quite impossible... Try this code and when LWPOLYLINE is created, try to zoom to touching point - you'll see 2 close points, then make line between those points and finally stretch them with grips so that they are coincident with mid point of just created small line... Now when you zoom out, you'll see that circle disappeared leaving just line - so conclusion is that with the code you can make just as close as this one, but touching is not possible...

--- Code - Auto/Visual Lisp: ---(defun c:lwcitanli ( / p1 p2 li ci osm p d gr pp r c1 c2 c cix li1 li2 par s pea lw lwx ) (setq p1 (getpoint "\nPick or specify first point : ")) (setq p2 (getpoint p1 "\nPick or specify second point : ")) (setq li (entmakex (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p2 1 0)) '(62 . 1)))) (setq ci (entmakex (list '(0 . "CIRCLE") '(100 . "AcDbEntity") '(100 . "AcDbCircle") '(10 0.0 0.0 0.0) '(40 . 0.0) '(62 . 1)))) (setq osm (getvar 'osmode)) (setvar 'osmode 512) (setq p (getpoint "\nPick or specify point on drawn red LINE : ")) (setvar 'osmode osm) (initget 7) (setq d (getdist "\nPick or specify diameter of CIRCLE : ")) (while (/= 3 (car (setq gr (grread t)))) (setq pp (cadr gr)) (setq r (/ d 2.0)) (setq c1 (polar p (+ (angle p1 p2) (* 0.5 pi)) r)) (setq c2 (polar p (- (angle p1 p2) (* 0.5 pi)) r)) (if (< (distance pp c1) (distance pp c2)) (setq cix (list (cons -1 ci) (cons 10 (setq c c1)) (cons 40 r))) (setq cix (list (cons -1 ci) (cons 10 (setq c c2)) (cons 40 r))) ) (entupd (cdr (assoc -1 (entmod cix)))) ) (command "_.BREAK" li "_non" p "_non" p) (setq li1 li) (setq li2 (entlast)) (setq par (vlax-curve-getparamatpoint ci (vlax-curve-getclosestpointto ci (trans p 1 0)))) (setq p1 (vlax-curve-getpointatparam ci (- par (cvunit 0.01 "degree" "radian")))) (setq p2 (vlax-curve-getpointatparam ci (+ par (cvunit 0.01 "degree" "radian")))) (command "_.BREAK" ci "_non" (trans p1 0 1) "_non" (trans p2 0 1)) (entupd (cdr (assoc -1 (entmod (cond ( (equal (assoc 10 (entget li1)) (cons 10 p) 1e-6) (subst (cons 10 (if (< (distance p1 (cdr (assoc 11 (entget li1)))) (distance p2 (cdr (assoc 11 (entget li1))))) p1 p2)) (assoc 10 (entget li1)) (entget li1)) ) ( (equal (assoc 11 (entget li1)) (cons 11 p) 1e-6) (subst (cons 11 (if (< (distance p1 (cdr (assoc 10 (entget li1)))) (distance p2 (cdr (assoc 10 (entget li1))))) p1 p2)) (assoc 11 (entget li1)) (entget li1)) ) ) ) ))) (entupd (cdr (assoc -1 (entmod (cond ( (equal (assoc 10 (entget li2)) (cons 10 p) 1e-6) (subst (cons 10 (if (< (distance p1 (cdr (assoc 11 (entget li2)))) (distance p2 (cdr (assoc 11 (entget li2))))) p1 p2)) (assoc 10 (entget li2)) (entget li2)) ) ( (equal (assoc 11 (entget li2)) (cons 11 p) 1e-6) (subst (cons 11 (if (< (distance p1 (cdr (assoc 10 (entget li2)))) (distance p2 (cdr (assoc 10 (entget li2))))) p1 p2)) (assoc 11 (entget li2)) (entget li2)) ) ) ) ))) (setq s (ssadd)) (ssadd li1 s) (ssadd li2 s) (ssadd ci s) (setq pea (getvar 'peditaccept)) (setvar 'peditaccept 1) (command "_.PEDIT" "_M" s "" "_J" "_J" "_E" 0.0 "") (setvar 'peditaccept pea) (setq lw (entlast)) (setq lwx (entget lw)) ;| (entupd (cdr (assoc -1 (entmod (setq lwx (subst (cons 10 p) (cons 10 p1) lwx)))))) (entupd (cdr (assoc -1 (entmod (setq lwx (subst (cons 10 p) (cons 10 p2) lwx)))))) |; (entupd (cdr (assoc -1 (entmod (subst '(62 . 3) '(62 . 1) lwx))))) (princ))
BTW. If you remove comment to 2 lines that were commented at the end of code, CAD won't (entmod) LWPOLYLINE like it's expected... So even CAD knows when it's much, it's too much...

Navigation

[0] Message Index

[#] Next page

Go to full version