TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Aerdvark on August 28, 2009, 02:33:30 AM
-
Hello,
I have read this topic but is did not solve my problem: http://www.theswamp.org/index.php?topic=17392.0
When drawing polylines, sometimes they need to be chamfered. That can only be done when exploding the polyline.
Or not drawing polylines but drawing just plain and simple lines.
What I was searching for (and I have done a lot searching) is a routine that would be able to:
1. prompt for the polyline to be chamfered
2. prompt for the remaining polyline
3. promt the side of chamfer
In the routine itself (or 4.) the chamfer distance A and B can be given.
See image for what I mean.
I have tried several routines like this:
; Chamfers first line to second line and leaves second line unchanged.
; In other words, does not trim second line to chamfer.
;
(DEFUN C:CHAMFER2 (/ A B AN BN AE BE AN1
AN2 TN1 TN2 TN3 NS RS R C)
(SETVAR "CMDECHO" 0)
(SETQ B (ENTSEL "LINE TO CHAMFER: ")
BN (OSNAP (CADR B) "NEAR")
BE (OSNAP (CADR B) "END")
A (ENTSEL "UNCHANGING LINE: ")
AN (OSNAP (CADR A) "NEAR")
AE (OSNAP (CADR A) "END")
NS (INTERS AN AE BN BE NIL)
RS (STRCAT "CHAMFER <" (RTOS
(GETVAR "CHAMFERA")) ">: ")
R (GETREAL RS))
(IF R (SETVAR "CHAMFERA" R)
(SETQ R (GETVAR "CHAMFERA"))
)
(SETQ AN1 (ANGLE NS AN)
AN2 (ANGLE NS BN)
C (- AN2 AN1))
(IF (> C PI)
(SETQ C (- C (* 2.0 PI))))
(IF (< C (- PI))
(SETQ C (+ C (* 2.0 PI))))
(SETQ TN3 (ABS (/ (* R (COS
(/ C 2.0 ))) (SIN (/ C 2.0))))
TN1 (POLAR NS AN1 TN3)
TN2 (POLAR NS AN2 TN3))
(IF (MINUSP C)
(COMMAND "LINE" TN1 TN2 "")
(COMMAND "LINE" TN2 TN1 "")
)
(COMMAND "CHANGE" (CAR B) "" TN2)
(SETVAR "CMDECHO" 1)
)
But this given routine only works with lines, not polylines.
Also it does not work constant: half the time it does create zero length lines.
Anyway... does anybody have a routine that does the trick?
Or maybe kick me in the right direction?
Thanks already.
-
Here is one that I use. It is not a standalone routine, but hopefully it will give you some ideas.
-
And fillet routine...
-
Gary,
What does the Cnotch button do?
-
Gary,
What does the Cnotch button do?
-
Could it be possible to have the main and other defun's??
like
; error: no function definition: ARCH:DIALOG_SETUP
thanks in advance
-
Could it be possible to have the main and other defun's??
like
; error: no function definition: ARCH:DIALOG_SETUP
thanks in advance
http://www.theswamp.org/index.php?topic=8749.15
-
Hello there again,
Still can't let go...
I played with the routines in this threat:
http://www.theswamp.org/index.php?topic=17392.0
(http://www.theswamp.org/index.php?topic=17392.0)
If one of the 2 codes below (thanks to CAB and A_LOTA_NOTA) would work with chamfer and polylines it would be great.
But I have no clue why it don't work.
Maybe you guys can help me out?
In the end the result is the same as it is now but only I have polylines and the arc's can be straight lines...
(defun c:efillet (/ e1 e2 elst OldRad Entz)
(if (not (zerop (getvar "filletrad")))
(progn
(while (not e1)
(initget 1 "Radius")
(setq e1 (entsel "Select first object or [Radius]:"))
(if (or (= e1 "Radius") (= e1 "R"))
(progn
(setq OldRad (rtos (getvar "filletrad")))
(setq NewRad (getreal (strcat "\nSpecify fillet radius < " OldRad " > : ")))
(if (/= NewRad nil)
(setvar "filletrad" NewRad)
)
(setq e1 nil)
)
)
)
(setq Entz (car e1))
(redraw Entz 3)
(while (not e2)
(setq e2 (entsel "\nSelect line to keep"))
)
(setq elst (entget (car e2)))
(not (command "_fillet" e1 e2))
(equal (assoc 0 (entget (entlast))) '(0 . "ARC"))
(entmod elst)
)
(progn
(prompt "\nRadius must be > 0.")
)
)
(princ)
)
or...
;; CAB 07.09.07
(defun c:efillet1 (/ e1 e2 elst rad)
(defun set_radius (/ NewRad)
(if
(and
(not (initget 6))
(setq NewRad (getdist (strcat "\nSpecify fillet radius < "
(rtos (getvar "filletrad"))
" > : ")))
)
(setvar "filletrad" NewRad)
)
nil
)
(if (zerop (getvar "filletrad"))
(set_radius)
)
(while
(progn
(initget "Radius")
(setq e1 (entsel "\nSelect line to fillet or [Radius]:"))
(if (= e1 "Radius")
(set_radius)
)
(/= (type e1) 'list)
)
)
(while (not (setq e2 (entsel "\nSelect line to keep"))))
(setq elst (entget (car e2)))
(command "_fillet" e1 e2)
(if (> (getvar "CMDACTIVE") 0)
(progn
(command)
(princ "\nCannot fillet between these two entities.")
)
(if (equal (assoc 0 (entget (entlast))) '(0 . "ARC"))
(entmod elst)
)
)
(princ)
)