TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Aerdvark on August 28, 2009, 02:33:30 AM

Title: Enhanced chamfer needed
Post 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:
Code: [Select]
; 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.
Title: Re: Enhanced chamfer needed
Post by: GDF on August 28, 2009, 10:44:50 AM
Here is one that I use. It is not a standalone routine, but hopefully it will give you some ideas.
Title: Re: Enhanced chamfer needed
Post by: GDF on August 28, 2009, 10:56:14 AM
And fillet routine...
Title: Re: Enhanced chamfer needed
Post by: CAB on August 28, 2009, 11:51:15 AM
Gary,
What does the Cnotch  button do?
Title: Re: Enhanced chamfer needed
Post by: GDF on August 28, 2009, 12:04:44 PM
Gary,
What does the Cnotch  button do?
Title: Re: Enhanced chamfer needed
Post by: DEVITG on August 30, 2009, 04:17:02 PM
Could it be possible to have the main and other defun's??

like

; error: no function definition: ARCH:DIALOG_SETUP

thanks in advance
Title: Re: Enhanced chamfer needed
Post by: GDF on August 31, 2009, 10:51:37 AM
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
Title: Re: Enhanced chamfer needed
Post by: Aerdvark on October 20, 2009, 05:58:30 PM
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...

Code: [Select]
(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...
Code: [Select]
;;  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)
)