Author Topic: Another transition.. ENTSEL has me!  (Read 1404 times)

0 Members and 1 Guest are viewing this topic.

ScottMC

  • Newt
  • Posts: 194
Another transition.. ENTSEL has me!
« on: September 08, 2023, 08:52:36 PM »
Seeing the fact that my inexperience can cost.
Trying without ANY success to 'filter selection and
loop until obtained' [on both] The program is ancient
but new to me and valuable <getting integration
understanding will be priceless>
Have been looking and attempting but no success.
  https://www.theswamp.org/index.php?topic=51090.0

forgive my inexperience...

Code: [Select]

(defun c:fr (/ *error*)
  ;; https://www.theswamp.org/index.php?topic=51090.0
  (princ "\n *Reverse Fillet* <lines>")

  (defun *error* (msg)
    (vla-endundomark
      (vla-get-activedocument (vlax-get-acad-object))
    ) ;_ end of vla-endundomark
                                                  ;(if qaf (setvar 'qaflags qaf))
    (if msg
      (prompt msg)
    ) ;_ end of if
    (vl-cmdf)
    (setvar 'cmdecho 1)
    (princ)
  ) ;_ end of defun

  (setvar 'cmdecho 0)
  (princ (strcat "\n Enter/Pick Fillet Radius:  < Currently: "
                 (rtos (getvar 'filletrad) 2 4)
                 " > "
         ) ;_ end of strcat
  ) ;_ end of princ
  (command "fillet" "r" (getdist))
  (defun ARCH:FILLET (/ *error* ent cen rad ang1 ang2 inc lst p1 p2)

    (defun *error* (msg)
      (vla-endundomark
        (vla-get-activedocument (vlax-get-acad-object))
      ) ;_ end of vla-endundomark
                                                  ;(if qaf (setvar 'qaflags qaf))
      (if msg
        (prompt msg)
      ) ;_ end of if
      (setvar 'cmdecho 1)
      (princ)
    ) ;_ end of defun

    (while

      (setq ent1
             (entget
               (car
                 (entsel
                   (strcat
                     "\n* Match Layer of Select Entities to Fillet..  Current Radius: "
                     (rtos (getvar 'filletrad))
                     "\n Select First Line.."
                   ) ;_ end of strcat
                 ) ;_ end of entsel
               ) ;_ end of car
             ) ;_ end of entget
      ) ;_ end of setq
       (setq ent2
              (entget (car (entsel "\n Select Second Line ")))
       ) ;_ end of setq
       (setvar 'clayer (cdr (assoc '8 ent1)))
       (setq rad (getvar 'filletrad))
       (command "fillet" (cdar ent1) (cdar ent2))
       (while (> (getvar 'cmdactive) 0) (vl-cmdf "\\"))
       (setq ent (entlast))
       (setq lst  (entget ent)
             cen  (cdr (assoc 10 lst))            ; center point
             rad  (cdr (assoc 40 lst))            ; radius
             ang1 (cdr (assoc 50 lst))            ; start angle
             ang2 (cdr (assoc 51 lst))            ; end angle
             inc  (- ang1 ang2)                   ; included angle
             inc  (if (minusp inc)
                    (- inc)
                    (- (* pi 2.0) inc)
                  )                               ; included angle correction
             p1   (polar cen ang1 rad)            ; start point
             p2   (polar cen ang2 rad)            ; end point
       ) ;_ end of setq
       (command "zoom" "w" p1 p2)                 ; zooms to endpoints of selected lines ; 3.21.20 zoom-to solution...
       (command "rotate"
                ent
                ""
                (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.))
                "180"
       ) ;_ end of command
       (command "Zoom" "_P")                      ; restores view to what it was
       (*error* nil)
    ) ;_ end of while
    (*error* nil)
    (princ)
  ) ;_ end of defun
  (ARCH:FILLET)
  (*error* nil)
  (setvar 'cmdecho 1)
  (princ)
) ;_ end of defun


ScottMC

  • Newt
  • Posts: 194
Re: Another transition.. ENTSEL has me!
« Reply #1 on: September 09, 2023, 08:21:19 PM »
And to further entertain, Here's one from Ron Leigh l.o.n.g ago..
Code: [Select]
;|  COVE  https://ronleigh.com/autolisp/ales13.htm  https://ronleigh.com/autolisp/index.htm
    Copyright © 1988,1998 Ronald W. Leigh
    Input: radius and 2 lines
    Output: draws cove

Variables:
a,b,c,d  Endpoints of lines
aa,cc    Angle from cen to a,c
cen      Center of arc (intersection of two lines)
coverad  Radius of cove, GLOBAL
el1/el2  Entity lists
en1/en2  Entity names
oom      Old osnap mode
temp     Temporary value

   b                  a
    ------------------    cen

                             c
                           |
                           |
                           |
                           |
                           |
                           |
                             d            |;

                                                  ;10====PROGRAM, SETUP

(defun c:cove (/ a b c d aa cc cen el1 el2 en1 en2 oom temp)
  ;(setq pi 3.1415926535897932385)
  (setq oom (getvar "osmode"))
  (setvar "osmode" 0)

                                                  ;20====GET RADIUS, LINES, ENDPOINTS, INTERSECTION

  (if (null coverad)
    (setq coverad 1.0)
  ) ;_ end of if
  (initget 6)
  (setq
    temp (getreal (strcat "\nCove radius <" (rtos coverad 2 4) ">: ")
         ) ;_ end of getreal
  ) ;_ end of setq
  (if temp
    (setq coverad temp)
  ) ;_ end of if

  (setq en1 (car (entsel "\nSelect first line: ")))
  (setq en2 (car (entsel "\nSelect second line: ")))
  (setq el1 (entget en1)
        el2 (entget en2)
  ) ;_ end of setq
  (setq a (cdr (assoc 10 el1))
        b (cdr (assoc 11 el1))
        c (cdr (assoc 10 el2))
        d (cdr (assoc 11 el2))
  ) ;_ end of setq
  (setq cen (inters a b c d nil))

                                                  ;30====DETERMINE CODE OF ENDPOINTS NEAREST INTERSECTION

  (if (null cen)
    (princ
      "\n**Lines are parallel or coincident. Cove impossible."
    ) ;_ end of princ
    (progn
      (if (< (distance cen a) (distance cen b))
        (setq code1 10)
        (setq temp a
              a b
              b temp
              code1 11
        ) ;_ end of setq
      ) ;_ end of if
      (if (< (distance cen c) (distance cen d))
        (setq code2 10)
        (setq temp c
              c d
              d temp
              code2 11
        ) ;_ end of setq
      ) ;_ end of if

                                                  ;40----MODIFY ENDPOINTS

      (setq a (polar cen (angle a b) coverad)
            c (polar cen (angle c d) coverad)
      ) ;_ end of setq
      (entmod (subst (cons code1 a) (assoc code1 el1) el1))
      (entmod (subst (cons code2 c) (assoc code2 el2) el2))
      (setq aa (angle cen a)
            cc (angle cen c)
      ) ;_ end of setq

                                                  ;50----SWAP A AND C IF NEEDED, DRAW ARC

      (if (or (and (> aa cc) (< (- aa cc) pi))
              (and (< aa cc) (> (- cc aa) pi))
          ) ;_ end of or
        (setq temp a
              a c
              c temp
        ) ;_ end of setq
      ) ;_ end of if
      (setvar "cmdecho" 0)
      (command ".arc" "c" cen a c)
      (setvar "cmdecho" 1)
    ) ;_ end of progn
  ) ;_ end of if
  (setvar "osmode" oom)
  (princ)
) ;_ end of defun