Author Topic: fillet and block insert  (Read 6545 times)

0 Members and 2 Guests are viewing this topic.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: just can't get it to work correctly!
« Reply #15 on: November 01, 2007, 05:57:06 PM »
It depends on the relationships.
You can determine  ;
The closest|furthest end to the selection points ;
The closest|furthest end to the intersection|imaginaryintersection point ;
You can determine which has the smallest Y and X values thereby determining it's left->right orientation.


kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: just can't get it to work correctly!
« Reply #16 on: November 01, 2007, 06:57:24 PM »
Here is my elbow routine: Use it on the test drawing included.
I used dimscale divided by 10 so adjust the code for your use.
Code: [Select]
(defun c:elbow (/ line1 line2 oldlay p1 p2 p3 p4 ip ds pk1 pk2 ps1 ps2 el1 el2)
  (setq oldlay (getvar "clayer"))
  (vl-load-com)
  ;;      compute the bisecting angle between a1 & a2
  (defun bisect (a1 a2)
    (cond
      ((> a1 (+ a2 pi)) (+ (/ (- (+ a2 pi pi) a1) 2) a1))
      ((> a2 (+ a1 pi)) (+ (/ (abs (- a2 a1 pi pi)) 2) a2))
      ((> a1 a2) (+ (/ (- a1 a2) 2) a2))
      ((> a2 a1) (+ (/ (- a2 a1) 2) a1))
    )
  )

  (if (and (setq line1 (entsel "\nPick first line: "))
           (setq line2 (entsel "\nPick second line: "))
      )
    (if (and (= (cdr (assoc 0 (setq el1 (entget (car line1))))) "LINE")
             (= (cdr (assoc 0 (setq el2 (entget (car line2))))) "LINE")
             (setq p1 (cdr (assoc 10 el1))
                   p2 (cdr (assoc 11 el1))
                   p3 (cdr (assoc 10 el2))
                   p4 (cdr (assoc 11 el2))
                   ip (inters p1 p2 p3 p4 nil)
             )
        )
      (progn
        (command "._undo" "_begin")
        (setvar "clayer" (cdr (assoc 8 (entget (car line1)))))
        (setq ds (/ (getvar "dimscale") 10.))  ;   <-----<<<   dimscale modifier
        ;;  find the end point to keep & trim the lines
        (if
          (and
            (equal (angle p1 ip) (angle (osnap (cadr line1) "_nea") ip) 0.0001)
            (> (distance p1 ip) (distance (osnap (cadr line1) "_nea") ip))
          )
           (setq ps1 p1 ; change point 11
                 el1 (subst (cons 11 (polar ip (angle ip p1) ds)) (assoc 11 el1) el1)
           )
           (setq ps1 p2 ; change point 10
                 el1 (subst (cons 10 (polar ip (angle ip p2) ds)) (assoc 10 el1) el1)
           )
        )
        (entmod el1)

        (if
          (and
            (equal (angle p3 ip) (angle (osnap (cadr line2) "_nea") ip) 0.0001)
            (> (distance p3 ip) (distance (osnap (cadr line2) "_nea") ip))
          )
           (setq ps2 p3
                 el2 (subst (cons 11 (polar ip (angle ip p3) ds)) (assoc 11 el2) el2)
           )
           (setq ps2 p4
                 el2 (subst (cons 10 (polar ip (angle ip p4) ds)) (assoc 10 el2) el2)
           )
        )
        (entmod el2)

        (setq ang (bisect (angle ip ps1) (angle ip ps2)))
        (command "-insert" "elbow" "s" ds "_non" ip (* 180.0 (/ ang pi)))
        (command "._undo" "_end")

      )
    )
  )
  (setvar "clayer" oldlay)

  (princ)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ronjonp

  • Needs a day job
  • Posts: 7529
Re: just can't get it to work correctly!
« Reply #17 on: November 02, 2007, 12:25:09 PM »
Here is my contribution.

Code: [Select]
(defun dxf (x ename /)
  (cdr (assoc x (entget ename)))
)

(defun make-elbow (/)
  (if (not (tblsearch "block" "elbow"))
    (progn
      (entmake '((0 . "BLOCK")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbBlockReference")
(2 . "elbow")
(10 0.0 0.0 0.0)
(70 . 0)
)
      )
      (entmake '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbPolyline")
(90 . 2)
(70 . 128)
(10 0.53 0.884)
(10 0.884 0.53)
)
      )
      (entmake '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbPolyline")
(90 . 2)
(70 . 128)
(10 0.884 -0.53)
(10 0.53 -0.884)
)
      )
      (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
      (princ)
    )
  )
)

(defun c:fe (/ ANG INT L1 L2 LAY MPT PT1 PT2 PT3 PT4 E1 E2 D)
  (setq l1 (entsel "\nPick first line: ")
l2 (entsel "\nPick second line: ")
  )
  (if (and l1
   l2
   (= (dxf 0 (car l1)) "LINE")
   (= (dxf 0 (car l2)) "LINE")
      )
    (progn
      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
    e1 (car l1)
    e2 (car l2)
    d (getvar 'dimscale)
    lay (cdr (assoc 8 (entget e1)))
    int (inters (dxf 10 e1) (dxf 11 e1) (dxf 10 e2) (dxf 11 e2) nil)
    pt1 (vlax-curve-getClosestPointTo e1 (cadr l1))
    pt2 (vlax-curve-getClosestPointTo e2 (cadr l2))
    pt1 (polar int (angle int pt1) 1.0)
    pt2 (polar int (angle int pt2) 1.0)
    mpt (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2))
    ang (angle int mpt)
      )
      (command "_.fillet" l1 l2)
      (make-elbow)
      (setq blk (vla-insertblock
  (vla-get-modelspace doc)
  (vlax-3d-point int)
  "elbow"
  d
  d
  d
  ang
)
      )
      (vla-put-layer blk lay)
    )
  )
  (princ)
)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

jermjmm

  • Guest
Re: just can't get it to work correctly!
« Reply #18 on: November 02, 2007, 05:23:46 PM »
I got tired of trying to figure all that out ronjonp (WAY above my head), SO I went a little different route.  this is what I have now and it actually works. . . . well for the most part.  It trims the lines correctly and inserts the block, the only problem it has is the blocks are just a little off (yeah I know just like me), instead of it inserting the blocks at a rotation of 0 and 90 it inserts them at 359.51 and 87.63  I'm cornfused :|
Code: [Select]
(DEFUN C:fe2 ()
  (setq line1 (entsel "\nPick first line: "))
  (setq line2 (entsel "\nPick Second line: "))
(cdr (assoc 0 (setq el1 (entget (car line1)))))
(cdr (assoc 0 (setq el2 (entget (car line2)))))   
  (setq p1 (cdr (assoc 10 el1))
p2 (cdr (assoc 11 el1))
p3 (cdr (assoc 10 el2))
p4 (cdr (assoc 11 el2))
ip (inters p1 p2 p3 p4 nil)
ang1 (* 180.0 (/ (angle ip (cadr line1)) pi))
ang2 (* 180.0 (/ (angle ip (cadr line2)) pi))
  )
  (setvar 'clayer (cdr (assoc 8 (entget (car line1)))))
  (command "-insert"
   "TIC"
   "s"
   (getvar 'dimscale)
   ip
           ang1
  )
  (command "-insert"
   "TIC"
   "s"
   (getvar 'dimscale)
   ip
   ang2           
  )
  (command "_.fillet" line1 line2)
  (command "layerp")
  (princ)
)


including a dwg that shows what it is doing
<edit: code tags added by CAB>
« Last Edit: November 02, 2007, 06:37:17 PM by CAB »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: just can't get it to work correctly!
« Reply #19 on: November 02, 2007, 06:35:42 PM »
Nice work ron. :-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: just can't get it to work correctly!
« Reply #20 on: November 02, 2007, 10:55:05 PM »
, the only problem it has is the blocks are just a little off (yeah I know just like me), instead of it inserting the blocks at a rotation of 0 and 90 it inserts them at 359.51 and 87.63  I'm cornfused :|
Code: [Select]
ang1 (* 180.0 (/ (angle ip [color=red](cadr line1) [/color]) pi))
ang2 (* 180.0 (/ (angle ip [color=red](cadr line2) [/color]) pi))
Your problem stems from the fact that the pick point is not on the line exactly.
Notice in my code I used something like (osnap (cadr line1) "nea")
and Ron used (vlax-curve-getClosestPointTo e1 (cadr l1))
That is needed to put the point exactly on the line.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ronjonp

  • Needs a day job
  • Posts: 7529
Re: just can't get it to work correctly!
« Reply #21 on: November 03, 2007, 10:45:24 AM »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

jermjmm

  • Guest
Re: fillet and block insert
« Reply #22 on: November 03, 2007, 11:03:55 AM »
 :lol: you guys are awsome!! it works great now!
sorry, it's just cool to finally get it working right and have actually had a small hand in writing it.

thanks everybody for your help (and lessons).

ronjonp

  • Needs a day job
  • Posts: 7529
Re: fillet and block insert
« Reply #23 on: November 03, 2007, 11:24:01 AM »
:lol: you guys are awsome!! it works great now!
sorry, it's just cool to finally get it working right and have actually had a small hand in writing it.

thanks everybody for your help (and lessons).

Here is a break down of what is happening as well as "x"'s to show the points used. Hopefully you can learn a bit from it.

Code: [Select]
(defun dxf (x ename /)
  (cdr (assoc x (entget ename)))
)

(defun make-elbow (/)
  (if (not (tblsearch "block" "elbow"))
    (progn
      (entmake '((0 . "BLOCK")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbBlockReference")
(2 . "elbow")
(10 0.0 0.0 0.0)
(70 . 0)
)
      )
      (entmake '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbPolyline")
(90 . 2)
(70 . 128)
(10 0.53 0.884)
(10 0.884 0.53)
)
      )
      (entmake '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(67 . 0)
(8 . "0")
(100 . "AcDbPolyline")
(90 . 2)
(70 . 128)
(10 0.884 -0.53)
(10 0.53 -0.884)
)
      )
      (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
      (princ)
    )
  )
)

(defun rjp-vector_x (pt clr / l bl br ul ur)
  (setq l  (* 0.015 (getvar 'viewsize))
bl (polar pt 3.926 l)
br (polar pt -0.785 l)
ul (polar pt -3.926 l)
ur (polar pt 0.785 l)
  )
  (grvecs (list clr bl ur br ul))
)

(defun c:fe (/ ANG INT L1 L2 LAY MPT PT1 PT2 PT3 PT4 E1 E2 D BLK)
  (setq l1 (entsel "\nPick first line: ")
;;returns somthing like ((<Entity name: 7efb10e0> (9.52338 4.0471 0.0))
;;(car l1) retrieves the entity name and (cadr l1) retrieves the picked point.
l2 (entsel "\nPick second line: ")
   ;;same as above
  )
  (if (and l1
   ;;if l1 was picked and
   l2
   ;;l2 was picked
   (= (dxf 0 (car l1)) "LINE")
   ;;and l1 is a line
   (= (dxf 0 (car l2)) "LINE")
   ;;and l2 is a line
      )
    (progn ;;then we have what we need so lets rock n roll :)
   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
;;store document object as doc (needed to insert vla-block)
e1  (car l1)
;;store entity name in e1
e2  (car l2)
;;store entity name in e2
d   (getvar 'dimscale)
;;store dimscale in d
lay (cdr (assoc 8 (entget e1)))
;;store the layer of the first line picked in lay
int (inters (dxf 10 e1) (dxf 11 e1) (dxf 10 e2) (dxf 11 e2) nil)
;;get the intersection of line1 and line2 using the endpoints (shown as red "x")
pt1 (vlax-curve-getClosestPointTo e1 (cadr l1))
;;force the picked point to lie somwhere on line1 at the closest point from the actual pickpoint
pt2 (vlax-curve-getClosestPointTo e2 (cadr l2))
;;force the picked point to lie somwhere on line2 at the closest point from the actual pickpoint
pt1 (polar int (angle int pt1) 1.0)
;;get the point 1.0 distance away from the intersection point in the direction of the angle of int and pt1 (shown as yellow "x")
pt2 (polar int (angle int pt2) 1.0)
;;get the point 1.0 distance away from the intersection point in the direction of the angle of int and pt2 (shown as green "x")
mpt (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2))
;;get the midpoint between pt1 and pt2 (shown as cyan "x")
ang (angle int mpt)
     ;;get the angle of int and mpt in radians (shown as blue line)
   )
   (rjp-vector_x int 1)
   (rjp-vector_x pt1 2)
   (rjp-vector_x pt2 3)
   (rjp-vector_x mpt 4)
   (grdraw int mpt 5)
   (command "_.fillet" l1 l2);;fillet the lines
   (make-elbow);;run subroutine to make sure the block definition exists
   (setq blk (vla-insertblock
       (vla-get-modelspace doc)
       (vlax-3d-point int)
       "elbow"
       d
       d
       d
       ang
     )
   );;insert the block
   (vla-put-layer blk lay);;put the block on the same layer as the first line picked
    )
    ;;not all requirements were met
  )
  ;;clean exit on command line
  (princ)
)

Ron

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

jermjmm

  • Guest
Re: fillet and block insert
« Reply #24 on: November 03, 2007, 12:12:05 PM »
thank you. beleive it or not I'm not trying to just get you guys to solve my problems, I'm trying to actually learn how to do this so I one day can be the one giving advice/help to others.

Maverick®

  • Seagull
  • Posts: 14778
Re: fillet and block insert
« Reply #25 on: November 03, 2007, 12:30:02 PM »
thank you. beleive it or not I'm not trying to just get you guys to solve my problems, I'm trying to actually learn how to do this so I one day can be the one giving advice/help to others.

That's what this place is all about!  :-) 

Although, If you don't post something helpful in a year we terminate your account, take over your computer, and change all of your bookmarks to Youtube links with little animals singing Metallica tunes.  Just sayin...


*Billy Crystal*  (I'm kidding, I'm a kidder)
« Last Edit: November 03, 2007, 12:33:38 PM by Maverick® »

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: fillet and block insert
« Reply #26 on: November 03, 2007, 12:42:32 PM »
Although, If you don't post something helpful in a year we terminate your account, take over your computer, and change all of your bookmarks to Youtube links with little animals singing Metallica tunes.  Just sayin...

So I've been meaning to ask ... are you sick of chipmunk metallica yet?

:P
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: fillet and block insert
« Reply #27 on: November 03, 2007, 03:17:20 PM »
Quote from: jermjmm
hey guys,
I know this is a really simple one, but it's the weekend and I'm having a brain fart.  when I try to run this lisp it keeps telling me "requires valid numeric angle or second point."  and I sure thought that I was giving it one. what's wrong with the lisp????

(DEFUN C:VA ()
  (SETQ OLD (GETVAR "OSMODE"))
  (SETVAR "OSMODE" 512)
  (SETQ x1 (GETVAR "DIMSCALE")
   ent1 (entsel "\nPick Insertion point")
   el1 (entget (car ent1))
   pt1 (cadr ent1)
  )
  (setvar "clayer" (cdr (assoc 8 (entget (car ent1)))))
  (command "-insert" "ball valve" "s" x1 pt1)
  (command "layerp"
   "osmode" old
  )
  (princ)
)

I'm not in a very chatty mood so you'll have to try and digest the concepts the following attempts to illuminate, which isn't necessarily how I'd code it up real world (i.e. use of command etc), but I wanted to keep it simple.

Code: [Select]
(defun c:va ( / blockName cmdecho attreq clayer ent insertPoint )

    [color=green];;  does the ball valve block exist in this drawing?[/color]

    (if (tblsearch "block" (setq blockName "ball valve"))
   
        [color=green];;  yeah,  we're cool, it exists[/color]
       
        (progn
       
            [color=green];;  save the system state before we muck with it[/color]
       
            (setq
                cmdecho (getvar "cmdecho")
                attreq  (getvar "attreq")
                clayer  (getvar "clayer")
            )
           
            [color=green];;  tailor the system to our needs[/color]
   
            (setvar "cmdecho" 0)
            (setvar "attreq" 0)
           
            [color=green];;  attempt to get an insert point from the user[/color]

            (if (setq insertPoint
                    (cadr
                        (setq ent
                            (entsel "Pick insert point: ")
                        )           
                    )
                )
               
                [color=green];;  user provided a point, insert the block[/color]
               
                (progn
               
                    (setvar "clayer" (cdr (assoc 8 (entget (car ent)))))
   
                    (command ".insert"
                        blockName   [color=green];; duh[/color]
                        "_nearest"  [color=green];; force a snap mode[/color]
                        insertPoint [color=green];; duh[/color]
                        1.0         [color=green];; xscale[/color]
                        ""          [color=green];; enter = "yscale same as xscale"[/color]
                        0.0         [color=green];; rotation[/color]
                    )
                   
                )   
               
                [color=green];;  user failed to provide an insert point[/color]
               
                (princ
                    (strcat
                        "Insert point not provided, bailing."
                    )
                )                                           
               
            )
           
            [color=green];;  restore the system state [/color]   
           
            (setvar "cmdecho" cmdecho)
            (setvar "attreq" attreq)
            (setvar "clayer" clayer)
           
        )   
       
        [color=green];;  advise the user of block state[/color]
   
        (princ
            (strcat
                blockname
                " does not exist in this drawing."
            )   
        )
   
    )
   
    [color=green];;  shhh ...[/color]
   
    (princ)   
   
)

FWIW
« Last Edit: November 03, 2007, 03:29:50 PM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: fillet and block insert
« Reply #28 on: November 03, 2007, 10:04:24 PM »
I'm not in a very chatty mood so you'll have to try and digest the concepts the following attempts to illuminate, which isn't necessarily how I'd code it up real world (i.e. use of command etc), but I wanted to keep it simple.


Combining educational, explicit and succinct is a real skill.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.