Jump to content

Bevel (slope) Label

Cadkiller

By Cadkiller
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

BIGAL Grand Master

BIGAL

Posted
Posted

Can use the internal angle it is used in the calcs I think its tanang I will check a simple fix.

  • Replies 52
  • Created
  • Last Reply

Top Posters In This Topic

  • Cadkiller

    26

  • BIGAL

    23

  • SLW210

    2

  • Tsuky

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Tsuky
Tsuky

I have this for a metric system, I don't know if it would be suitable for a foot system...! But it can be a start for you. (defun C:SLOPE ( / blp pt_o pt_f frac_prec sv_osmd e_last dxf_o slope slop

Posted Images

Cadkiller Apprentice

Cadkiller

Posted
  • Author
Posted

Hey Big Al,

 

I tried your lisp code and noticed something is wrong with the bevel answer.

This line I'm labeling is on a 45-degree angle, but the vertical answer is 10 1/2" and it should be 12".

 

image.png.ca0e637f615faca402dbeb2d176d8a5e.png

BIGAL Grand Master

BIGAL

Posted
Posted

I will check the less than greater than check, sound like its wrong I know it worked at 47 degrees during testing. 

BIGAL Grand Master

BIGAL

Posted
Posted

I will check the less than greater than check, sound like its wrong I know it worked at 47 degrees during testing. 

BIGAL Grand Master

BIGAL

Posted
Posted

try this I changed the cond to look for an exact 45 angle.

  

; https://www.cadtutor.net/forum/topic/97227-bevel-slope-label/

; draw bevel label
; By AlanH April 2025

; (defun c:bevel ( / ah045 ah4590 ah90135 ah135180 ah180225 ah225270 ang d1 d2 dist dofracs dofracs endpt ht oldangdir oldcol oldsnap pt2 pt2a startpt tanang)
(defun c:bevel ( / )
; thanks to lee-mac for this defun
(defun csv->lst (str ans / pos )
  (if (setq pos (vl-string-position ans str))
    (cons (substr str 1 pos) (csv->lst (substr str (+ pos 2)) ans))
    (list str)
  )
)

(defun dofracs ( / a ht1 ht2 ht3 ht4 frac)
(setq frac (- ht (fix ht)))
(cond
  ((and  (> frac 0.0624)(< frac 0.9375))
   (progn
   (setq txt (rtos ht 4 4))
   (setq a (csv->lst txt 32))
   (setq ht1 (car a))
   (setq ht2 (csv->lst (cadr a) 47))
   (setq ht3 (car ht2))
   (setq ht4 (cadr ht2))
   (setq httxt (strcat ht1 "{\\H0.70x;\\S" ht3 "#" ht4 ";}"))
  ))
  ((< frac 0.0625)(setq httxt (rtos (fix ht) 4 1)))
  (setq httxt "12\"")
)
(princ)
)

(DEFUN AH045 ( / angt  mp pt3 pt4)
(setq pt3 (polar pt2a (* pi 1.5) dist))
(setq pt4 (polar pt3 pi 4.))
(command "line" startpt pt2 "")
(command "line" pt2a  pt3 "")
(command "line" pt3 pt4 "")
(setq ht (* 3. dist))
(setq angt (/ (* ang 180.0) pi))
(setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
(setq mp (mapcar '+ mp  '(0.25 0.0 0.0)))
(dofracs)
(command "mtext" mp "J" "ML" mp httxt "")
(setq mp (polar pt3 pi 2.0))
(setq mp (mapcar '+ mp  '(0.0 -0.25 0.0)))
(command "text" "J" "TC" mp 1 0.0 "12\"")
(setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
(setq mp (mapcar '+ mp  '(0.0 0.25 0.0)))
(setvar 'angdir 0)
(command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 2) "%%d"))
(princ)
)

(DEFUN AH4590 ( / angt mp pt3 pt4)
  (setq pt3 (polar pt2a (* pi 1.5) 4.0))
  (setq pt4 (polar pt3 pi (/ 4.0 tanang)))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (* 3. dist))
  (setq angt (/ (* ang 180.0) pi))
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.0 0.0)))
  (command "mtext" mp "J" "ML" mp "12\"" "")
  (setq mp (mapcar '* (mapcar '+ pt3 pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0)))
  (setq ht (/ 12.0 tanang))
  (dofracs)
  (command "mtext" mp "J" "TL" mp httxt "")
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 -0.25 0.0)))
  (command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH90135 ( / angt  mp pt3 pt4)
  (setq pt3 (polar pt2a (* pi 1.5) 4.0))
  (setq pt4 (polar pt3 0.0 (/ 4.0 tanang)))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq angt (/ (* (- pi ang) 180.0) pi))
  (setq httxt "12\"" )
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (mapcar '* (mapcar '+ pt3 pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (setq ht (/ 12. tanang))
  (dofracs)
  (command "mtext" mp "J" "TR" mp httxt "")
  (setvar 'angdir 1)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH135180 ( / angt  mp pt3 pt4)
  (setq pt3 (polar pt2a (* pi 1.5) dist))
  (setq pt4 (polar pt3 0.0 4.))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (abs (* 12.0 tanang)))
  (dofracs)
  (setq angt (/ (* (- pi ang) 180.0) pi))
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (polar pt3 0.0 2.0))
  (setq mp (mapcar '+ mp '(0.0 -0.25 0.0)))
  (setq httxt "12\"")
  (command "mtext" mp "J" "TC" mp  "12\"" "")
  (setvar 'angdir 1)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)


(DEFUN AH180225 ( / angt  mp pt3 pt4 )
  (setq pt3 (polar pt2a (* pi 0.5) dist))
  (setq pt4 (polar pt3 0.0 4.))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (* 3. dist))
  (setq angt (/ (* (- ang pi) 180.0) pi))
  (dofracs)
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (polar pt3 0.0 2.0))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0 )))
  (command "text" "J" "BC" mp 1 0.0 "12\"")
  (setvar 'angdir 0)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 -0.25 0.0 )))
  (command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH225270 ( / angt  mp pt3 pt4 )
  (setq pt3 (polar pt2a (* pi 0.5) 4.0))
  (setq pt4 (polar pt3 0.0 (abs (/ 4.0 tanang))))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq angt (/ (* (- ang pi) 180.0) pi))
  (setq httxt "12\"")
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (polar pt3 0.0 2.0))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0 )))
  (setq ht (abs (/ 12.0 tanang)))
  (dofracs)
  (command "mtext" mp "J" "BC" mp httxt "")
  (setvar 'angdir 0)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 -0.25 0.0 )))
  (command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH270315 ( / angt  mp pt3 pt4 )
  (setq pt3 (polar pt2a (* pi 0.5) 4.0))
  (setq pt4 (polar pt3 pi (abs (/ 4.0 tanang))))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq httxt "12\"" )
  (setq angt (/ (* (- (* 2.0 pi) ang) 180.0) pi))
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.0 0.0 )))
  (command "mtext" mp "J" "BL" mp httxt "")
  (setq mp (mapcar '* (mapcar '+ pt3 pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.25 0.0 )))
  (setq ht (abs (/ 12.0 tanang)))
  (dofracs)
  (command "mtext" mp "J" "BL" mp httxt "")
  (setvar 'angdir 1)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (polar mp  (- ang (/ pi 2.0)) 0.25 ))
  (command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH3150 ( / angt  mp pt3 pt4 )
(setq pt3 (polar pt2a (* pi 0.5) dist))
(setq pt4 (polar pt3 pi 4.))
(command "line" startpt pt2 "")
(command "line" pt2a  pt3 "")
(command "line" pt3 pt4 "")
(setq ht (* 3. dist))
(setq angt (/ (* (- (* 2.0 pi) ang) 180.0) pi))
(dofracs)
(setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
(setq mp (mapcar '+ mp  '(0.25 0.0 0.0 )))
(command "mtext" mp "J" "ML" mp httxt "")
(setq mp (polar pt3 pi 2.0))
(setq mp (mapcar '+ mp  '(0.0 0.25 0.0 )))
(command "text" "J" "BC" mp 1 0.0 "12\"")
(setvar 'angdir 1)
(setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
(setq mp (polar mp  (- ang (/ pi 2.0)) 0.25 ))
(command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
(princ)
)

;; starts here

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldcol (getvar 'cecolor))
(setvar 'cecolor "1")
(setq oldangdir (getvar 'angdir))
(setvar 'textstyle "standard")
(setvar 'textsize 1)
(setq pi90 (* 0.5 pi) pi270 (* 1.5 pi))

(if (= (tblsearch "layer" "Beveldim") nil)
(command "-layer" "M" "Beveldim" "C" "1" "" "")
(setvar 'clayer "Beveldim")
)

(setq ent (entsel "\npick a line near end "))

(setq obj (vlax-ename->vla-object (car ent)))
(setq startpt (vlax-curve-getstartPoint obj))
(setq endpt (vlax-curve-getEndPoint obj))
(setq pt1 (cadr ent))
(setq d1 (distance pt1 startpt))
(setq d2 (distance pt1 endpt))
(if (> d1 d2)
   (setq tmp startpt
   startpt endpt
   endpt tmp)
)
(setq ang (angle endpt startpt))
(setq tanang (abs (/ (sin ang) (cos ang))))
(setq dist (abs (* 4.0 tanang)))
(setq hyp (abs (/ 4.0 (sin (- ang (* 1.5 pi))))))
(setq pt2 (polar startpt ang  6.5))
(setq pt2a (polar startpt ang 6.25))

(cond
((and (>= ang 0.0)(< ang (* pi 0.25)))(AH045))
((and (>= ang (* pi 0.25))(< ang (* pi 0.5)))(AH4590))
((and (>= ang (/ pi 2.0))(< ang (* 0.75 pi ))(AH90135)))
((and (>= ang (* 0.75 pi ))(< ang pi ))(AH135180))
((and (>= ang pi)(< ang (* 1.25 pi )))(AH180225))
((and (>= ang (* 1.25 pi ))(< ang (* 1.5 pi )))(AH225270))
((and (>= ang (* 1.5 pi ))(< ang (* 1.75 pi )))(AH270315))
((and (>= ang (* 1.75 pi ))(< ang (* 2.0 pi )))(AH3150))
)

(setvar 'osmode oldsnap)
(setvar 'cecolor oldcol)
(setvar 'angdir oldangdir)

(princ)
)

(c:bevel)

 

Cadkiller Apprentice

Cadkiller

Posted
  • Author
Posted

Thanks Big Al,

 

It worked but gave a 1'-0" instead of 12" like the other side and the position is slightly different.

 

image.png.00f651106c44bc0701e53f5097a4dec2.png

Cadkiller Apprentice

Cadkiller

Posted
  • Author
Posted

Also, the angle is still the same as previous.

Instead of giving the smaller angle (14.6) it gives the larger one (75.4).

 

image.thumb.png.241010e87e2eb38fe436214b6e20b500.png

BIGAL Grand Master

BIGAL

Posted
Posted (edited)

Ok missed that angle why not have a go. in the defuns look at the ones that are greater than 45, then the correct angle must add up to 180.0 so (- 180 angt 90) you have to work in radians. (rtos (- (/ pi 2.) angt) 2 1)

 

The 1' comes from the dofrac it gets 11.999999 inches so it makes it to 1' could add another check if "1'"  then use 12".

Edited by BIGAL
Cadkiller Apprentice

Cadkiller

Posted
  • Author
Posted

Big Al,

 

I gave it a go, but this is like a foreign language to me!

I have no clue as to what I need to change, where and to what.

BIGAL Grand Master

BIGAL

Posted
Posted

This should fix the angle as it can not be more than 45. the 1' is now 12" 

(defun c:bevel ( / ah045 ah4590 ah90135 ah135180 ah180225 ah225270 ang d1 d2 dist dofracs dofracs endpt ht obj oldangbase oldangdir oldcol oldsnap pt1 pt2 pt2a pi90 pi270 startpt tanang tmp)

; thanks to lee-mac for this defun
(defun csv->lst (str del / pos )
  (if (setq pos (vl-string-position del str))
    (cons (substr str 1 pos) (csv->lst (substr str (+ pos 2)) del))
    (list str)
  )
)

(defun dofracs ( / a ht1 ht2 ht3 ht4 frac)
(setq frac (- ht (fix ht)))
(cond
  ((and  (> frac 0.0624)(< frac 0.9375))
   (progn
   (setq txt (rtos ht 4 4))
   (setq a (csv->lst txt 32))
   (setq ht1 (car a))
   (setq ht2 (csv->lst (cadr a) 47))
   (setq ht3 (car ht2))
   (setq ht4 (cadr ht2))
   (setq httxt (strcat ht1 "{\\H0.70x;\\S" ht3 "#" ht4 ";}"))
  ))
  ((< frac 0.0625)(setq httxt (rtos (fix ht) 4 1)))
)
(if (= httxt "1'")(setq httxt "12\""))
(princ)
)

(DEFUN AH045 ( / angt  mp pt3 pt4)
  (setq pt3 (polar pt2a pi270 dist))
  (setq pt4 (polar pt3 pi 4.))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (* 3. dist))
  (setq angt (/ (* ang 180.0) pi))
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.0 0.0)))
  (dofracs)
  (command "mtext" mp "J" "ML" mp httxt "")
  (setq mp (polar pt3 pi 2.0))
  (setq mp (mapcar '+ mp  '(0.0 -0.25 0.0)))
  (command "text" "J" "TC" mp 1 0.0 "12\"")
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0)))
  (setvar 'angdir 0)
  (command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH4590 ( / angt mp pt3 pt4)
  (setq pt3 (polar pt2a pi270 4.0))
  (setq pt4 (polar pt3 pi (/ 4.0 tanang)))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (* 3. dist))
  (setq angt (/ (* ang 180.0) pi))
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.0 0.0)))
  (command "mtext" mp "J" "ML" mp "12\"" "")
  (setq mp (mapcar '* (mapcar '+ pt3 pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0)))
  (setq ht (/ 12.0 tanang))
  (dofracs)
  (command "mtext" mp "J" "TL" mp httxt "")
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 -0.25 0.0)))
  (setvar 'angdir 0)
  (command "text" "J" "BC" mp 1 angt (strcat (rtos (- 90.0 angt) 2 1) "%%d"))
  (princ)
)

(DEFUN AH90135 ( / angt  mp pt3 pt4)
  (setq pt3 (polar pt2a pi270 4.0))
  (setq pt4 (polar pt3 0.0 (/ 4.0 tanang)))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq angt (/ (* (- pi ang) 180.0) pi))
  (setq httxt "12\"" )
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (mapcar '* (mapcar '+ pt3 pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (setq ht (/ 12. tanang))
  (dofracs)
  (command "mtext" mp "J" "TR" mp httxt "")
  (setvar 'angdir 1)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (command "text" "J" "BC" mp 1 angt (strcat (rtos (- 90.0 angt) 2 1) "%%d"))
  (princ)
)

(DEFUN AH135180 ( / angt  mp pt3 pt4)
  (setq pt3 (polar pt2a pi270 dist))
  (setq pt4 (polar pt3 0.0 4.))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (abs (* 12.0 tanang)))
  (dofracs)
  (setq angt (/ (* (- pi ang) 180.0) pi))
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (polar pt3 0.0 2.0))
  (setq mp (mapcar '+ mp '(0.0 -0.25 0.0)))
  (setq httxt "12\"")
  (command "mtext" mp "J" "TC" mp  "12\"" "")
  (setvar 'angdir 1)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (command "text" "J" "BC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH180225 ( / angt  mp pt3 pt4 )
  (setq pt3 (polar pt2a pi90 dist))
  (setq pt4 (polar pt3 0.0 4.))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (* 3. dist))
  (setq angt (/ (* (- ang pi) 180.0) pi))
  (dofracs)
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (polar pt3 0.0 2.0))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0 )))
  (command "text" "J" "BC" mp 1 0.0 "12\"")
  (setvar 'angdir 0)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.0 -0.25 0.0 )))
  (command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

(DEFUN AH225270 ( / angt  mp pt3 pt4 )
  (setq pt3 (polar pt2a pi90 4.0))
  (setq pt4 (polar pt3 0.0 (abs (/ 4.0 tanang))))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq angt (/ (* (- ang pi) 180.0) pi))
  (setq httxt "12\"")
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp '(-0.25 0.0 0.0)))
  (command "mtext" mp "J" "MR" mp httxt "")
  (setq mp (polar pt3 0.0 2.0))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0 )))
  (setq ht (abs (/ 12.0 tanang)))
  (dofracs)
  (command "mtext" mp "J" "BC" mp httxt "")
  (setvar 'angdir 0)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 -0.25 0.0 )))
  (command "text" "J" "TC" mp 1 angt (strcat (rtos (- 90.0 angt) 2 1) "%%d"))
  (princ)
)

(DEFUN AH270315 ( / angt  mp pt3 pt4 )
  (setq pt3 (polar pt2a pi90 4.0))
  (setq pt4 (polar pt3 pi (abs (/ 4.0 tanang))))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq httxt "12\"" )
  (setq angt (/ (* (- (* 2.0 pi) ang) 180.0) pi))
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.0 0.0 )))
  (command "mtext" mp "J" "BL" mp httxt "")
  (setq mp (mapcar '* (mapcar '+ pt3 pt4) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.25 0.0 )))
  (setq ht (abs (/ 12.0 tanang)))
  (dofracs)
  (command "mtext" mp "J" "BL" mp httxt "")
  (setvar 'angdir 1)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (polar mp  (- ang pi90) 0.25 ))
  (command "text" "J" "TC" mp 1 angt (strcat (rtos (- 90.0 angt) 2 1) "%%d"))
  (princ)
)

(DEFUN AH3150 ( / angt  mp pt3 pt4 )
  (setq pt3 (polar pt2a pi90 dist))
  (setq pt4 (polar pt3 pi 4.))
  (command "line" startpt pt2 "")
  (command "line" pt2a  pt3 "")
  (command "line" pt3 pt4 "")
  (setq ht (* 3. dist))
  (setq angt (/ (* (- (* 2.0 pi) ang) 180.0) pi))
  (dofracs)
  (setq mp (mapcar '* (mapcar '+ pt2a pt3) '(0.5 0.5)))
  (setq mp (mapcar '+ mp  '(0.25 0.0 0.0 )))
  (command "mtext" mp "J" "ML" mp httxt "")
  (setq mp (polar pt3 pi 2.0))
  (setq mp (mapcar '+ mp  '(0.0 0.25 0.0 )))
  (command "text" "J" "BC" mp 1 0.0 "12\"")
  (setvar 'angdir 1)
  (setq mp (mapcar '* (mapcar '+ pt2a pt4) '(0.5 0.5)))
  (setq mp (polar mp  (- ang pi90) 0.25 ))
  (command "text" "J" "TC" mp 1 angt (strcat (rtos angt 2 1) "%%d"))
  (princ)
)

;; starts here

(setq oldsnap (getvar 'osmode))
(setvar 'osmode 0)
(setq oldcol (getvar 'cecolor))
(setvar 'cecolor "1")
(setq oldangdir (getvar 'angdir))
(setvar 'textstyle "standard")
(setvar 'textsize 1)

(setq oldangbase (getvar 'angbase))
(setvar 'angbase 0.0)

(setq pi90 (* 0.5 pi) pi270 (* 1.5 pi))

(if (= (tblsearch "layer" "Beveldim") nil)
(command "-layer" "M" "Beveldim" "C" "1" "" "")
(setvar 'clayer "Beveldim")
)

(setq ent (entsel "\npick a line near end "))

(setq obj (vlax-ename->vla-object (car ent)))
(setq startpt (vlax-curve-getstartPoint obj))
(setq endpt (vlax-curve-getEndPoint obj))
(setq pt1 (cadr ent))
(setq d1 (distance pt1 startpt))
(setq d2 (distance pt1 endpt))
(if (> d1 d2)
   (setq tmp startpt
   startpt endpt
   endpt tmp)
)
(setq ang (angle endpt startpt))
(setq tanang (abs (/ (sin ang) (cos ang))))
(setq dist (abs (* 4.0 tanang)))

(setq pt2 (polar startpt ang  6.5))
(setq pt2a (polar startpt ang 6.25))

(cond
((and (>= ang 0.0)(< ang (* pi 0.25)))(AH045))
((and (>= ang (* pi 0.25))(< ang (* pi 0.5)))(AH4590))
((and (>= ang pi90)(< ang (* 0.75 pi ))(AH90135)))
((and (>= ang (* 0.75 pi ))(< ang pi ))(AH135180))
((and (>= ang pi)(< ang (* 1.25 pi )))(AH180225))
((and (>= ang (* 1.25 pi ))(< ang (* 1.5 pi )))(AH225270))
((and (>= ang (* 1.5 pi ))(< ang (* 1.75 pi )))(AH270315))
((and (>= ang (* 1.75 pi ))(< ang (* 2.0 pi )))(AH3150))
)

(setvar 'osmode oldsnap)
(setvar 'cecolor oldcol)
(setvar 'angdir oldangdir)
(setvar 'angbase oldangbase)

(princ)
)

(c:bevel)

 

Cadkiller Apprentice

Cadkiller

Posted
  • Author
Posted

Thanks, Big Al,

 

I will test it out.

Hopefully this should resolve it.

Like I have previously said, I am truly grateful for your help with creating this code for me!

Cadkiller Apprentice

Cadkiller

Posted
  • Author
Posted (edited)

Okay I spoke too soon once again.

One shows a 12" on 12" and the angle is 9.4% and another was blank for some reason.

I gather because the angle is very low.

And a couple just showed the 12" base with no angle or rise, which this one seems to be very steep.

 

image.thumb.png.33efc33fc2fa2c33d0bc518989ad3efc.png

 

 

 

image.thumb.png.9bca60efad0cc958f65efc68de7c4b70.png

 

Edited by Cadkiller

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...