Author Topic: How to extend or cut?  (Read 3957 times)

0 Members and 1 Guest are viewing this topic.

myloveflyer

  • Newt
  • Posts: 152
How to extend or cut?
« on: May 22, 2019, 03:44:25 AM »
How to extend or cut a straight line by changing the diameter of the circle?See the DWG in the attachment for details.
Never give up !

ronjonp

  • Needs a day job
  • Posts: 7526
Re: How to extend or cut?
« Reply #1 on: May 22, 2019, 10:58:26 AM »
Better yet use a block with a mask and draw your lines to the insertion points  :wink:

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

myloveflyer

  • Newt
  • Posts: 152
Re: How to extend or cut?
« Reply #2 on: May 23, 2019, 09:26:16 PM »
Better yet use a block with a mask and draw your lines to the insertion points  :wink:
The drawings are from other software, because the diameter of the circle is fixed at the beginning, and the later labor needs to modify the diameter of the circle to make the line extend and cut.
Can you help me write this program to complete the straight line extension and cutting?
Never give up !

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2125
  • class keyThumper<T>:ILazy<T>
Re: How to extend or cut?
« Reply #3 on: May 23, 2019, 11:49:45 PM »
First thought

Select all by window filtered for lines and circles.
Isolate a circle in selection set
Determine current diameter
Prompt for new diameter

Calculate amount to reduce each end of each line ( half difference in circle size )
Iterate thtough selection set
If Circle, change diameter
If Line, calculate new start and end points based on calculated offset, move endpoints.
   Moving keeps any additional data associated with entity.

Go for a beer.
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: How to extend or cut?
« Reply #4 on: May 24, 2019, 08:24:01 PM »
Try this

Code: [Select]
; defun trim inside circles
; By Alan H May 2019 AlanH Consulting
; www.alanh.com.au


(defun aH:trimcircles (/ ss ang rad oldsnap oldaunits obj lay)

  (setq oldsnap (getvar "osmode"))
  (setq oldaunits (getvar 'aunits))
 
  (setq lay (cdr (assoc 8 (entget (car (entsel "Pick circle"))))))
  (setq ss (ssget (list (cons 0 "Circle") (cons 8 lay))))
 
  (setvar 'osmode 0)
  (setvar 'aunits 3)
 
  (repeat (setq x (sslength ss))
    (setq obj (entget (ssname ss (setq x (- x 1)))))
    (setq rad (cdr (assoc 40 obj)))
    (setq cenpt (list (nth 1 (assoc 10 obj)) (nth 2 (assoc 10 obj))))
    (setq ent (cdr (assoc -1 obj)))
    (setq rad (- rad 3))
    (setq lst '())
    (setq ang 0.0)
   
    (repeat 10
      (setq lst (cons (polar cenpt ang rad) lst))
      (setq ang (+ ang 0.62831853))
    )
   
    (command "trim" ent "" "fence")
    (while (= (getvar "cmdactive") 1)
      (repeat (setq y (length lst))
        (command (nth (setq y (- y 1)) lst))
      )
      (command "" "")
    )
  )

  (setvar 'osmode oldsnap)
  (setvar 'aunits oldaunits)

)

(aH:trimcircles)

(defun c:trci () (aH:trimcircles))
A man who never made a mistake never made anything

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: How to extend or cut?
« Reply #5 on: May 25, 2019, 05:56:07 AM »
Code - Auto/Visual Lisp: [Select]
  1. (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  2.   (if ss
  3.     (repeat (setq i (sslength ss))
  4.       (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
  5.     )
  6.   )
  7. )
  8.  
  9. (defun c:Test ( / cen cirLst doc linLst radNew radOld ss)
  10.   (if
  11.     (and
  12.       (setq ss (ssget '((0 . "LINE,CIRCLE"))))
  13.       (setq radNew (getreal "\nNew radius: "))
  14.     )
  15.     (progn
  16.       (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
  17.         (if (= "AcDbLine" (vla-get-objectname obj))
  18.           (setq linLst
  19.             (vl-list*
  20.               (list (vlax-get obj 'startpoint) T obj)
  21.               (list (vlax-get obj 'endpoint) nil obj)
  22.               linLst
  23.             )
  24.           )
  25.           (setq cirLst (cons obj cirLst))
  26.         )
  27.       )
  28.       (foreach cir cirLst
  29.         (setq cen (vlax-get cir 'center))
  30.         (setq radOld (vla-get-radius cir))
  31.         (vla-put-radius cir radNew)
  32.         (foreach sub linLst
  33.           (if (equal radOld (distance cen (car sub)) 1e-8)
  34.             (progn
  35.               (vlax-put
  36.                 (caddr sub)
  37.                 (if (cadr sub) 'startpoint 'endpoint)
  38.                 (vlax-curve-getclosestpointto cir (car sub))
  39.               )
  40.               (setq linLst (vl-remove sub linLst))
  41.             )
  42.           )
  43.         )
  44.       )
  45.     )
  46.   )
  47.   (princ)
  48. )
« Last Edit: May 25, 2019, 06:00:31 AM by roy_043 »

ronjonp

  • Needs a day job
  • Posts: 7526
Re: How to extend or cut?
« Reply #6 on: May 26, 2019, 12:36:29 AM »
Code - Auto/Visual Lisp: [Select]
  1. (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  2.   (if ss
  3.     (repeat (setq i (sslength ss))
  4.       (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
  5.     )
  6.   )
  7. )
  8.  
  9. (defun c:Test ( / cen cirLst doc linLst radNew radOld ss)
  10.   (if
  11.     (and
  12.       (setq ss (ssget '((0 . "LINE,CIRCLE"))))
  13.       (setq radNew (getreal "\nNew radius: "))
  14.     )
  15.     (progn
  16.       (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
  17.         (if (= "AcDbLine" (vla-get-objectname obj))
  18.           (setq linLst
  19.             (vl-list*
  20.               (list (vlax-get obj 'startpoint) T obj)
  21.               (list (vlax-get obj 'endpoint) nil obj)
  22.               linLst
  23.             )
  24.           )
  25.           (setq cirLst (cons obj cirLst))
  26.         )
  27.       )
  28.       (foreach cir cirLst
  29.         (setq cen (vlax-get cir 'center))
  30.         (setq radOld (vla-get-radius cir))
  31.         (vla-put-radius cir radNew)
  32.         (foreach sub linLst
  33.           (if (equal radOld (distance cen (car sub)) 1e-8)
  34.             (progn
  35.               (vlax-put
  36.                 (caddr sub)
  37.                 (if (cadr sub) 'startpoint 'endpoint)
  38.                 (vlax-curve-getclosestpointto cir (car sub))
  39.               )
  40.               (setq linLst (vl-remove sub linLst))
  41.             )
  42.           )
  43.         )
  44.       )
  45.     )
  46.   )
  47.   (princ)
  48. )
Nice  8-)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

myloveflyer

  • Newt
  • Posts: 152
Re: How to extend or cut?
« Reply #7 on: May 26, 2019, 09:07:25 PM »
Code - Auto/Visual Lisp: [Select]
  1. (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  2.   (if ss
  3.     (repeat (setq i (sslength ss))
  4.       (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
  5.     )
  6.   )
  7. )
  8.  
  9. (defun c:Test ( / cen cirLst doc linLst radNew radOld ss)
  10.   (if
  11.     (and
  12.       (setq ss (ssget '((0 . "LINE,CIRCLE"))))
  13.       (setq radNew (getreal "\nNew radius: "))
  14.     )
  15.     (progn
  16.       (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
  17.         (if (= "AcDbLine" (vla-get-objectname obj))
  18.           (setq linLst
  19.             (vl-list*
  20.               (list (vlax-get obj 'startpoint) T obj)
  21.               (list (vlax-get obj 'endpoint) nil obj)
  22.               linLst
  23.             )
  24.           )
  25.           (setq cirLst (cons obj cirLst))
  26.         )
  27.       )
  28.       (foreach cir cirLst
  29.         (setq cen (vlax-get cir 'center))
  30.         (setq radOld (vla-get-radius cir))
  31.         (vla-put-radius cir radNew)
  32.         (foreach sub linLst
  33.           (if (equal radOld (distance cen (car sub)) 1e-8)
  34.             (progn
  35.               (vlax-put
  36.                 (caddr sub)
  37.                 (if (cadr sub) 'startpoint 'endpoint)
  38.                 (vlax-curve-getclosestpointto cir (car sub))
  39.               )
  40.               (setq linLst (vl-remove sub linLst))
  41.             )
  42.           )
  43.         )
  44.       )
  45.     )
  46.   )
  47.   (princ)
  48. )
Thanks,roy_043!
But some CAD is a streamlined version, and a VL-function needs to add a line of code when it runs.
Code: [Select]
(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
    )
  )
)
(vl-load-com)
(defun c:Test ( / cen cirLst doc linLst radNew radOld ss)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (if
    (and
      (setq ss (ssget '((0 . "LINE,CIRCLE"))))
      (setq radNew (getreal "\nNew radius: "))
    )
    (progn
      (foreach obj (KGA_Conv_Pickset_To_ObjectList ss)
        (if (= "AcDbLine" (vla-get-objectname obj))
          (setq linLst
            (vl-list*
              (list (vlax-get obj 'startpoint) T obj)
              (list (vlax-get obj 'endpoint) nil obj)
              linLst
            )
          )
          (setq cirLst (cons obj cirLst))
        )
      )
      (foreach cir cirLst
        (setq cen (vlax-get cir 'center))
        (setq radOld (vla-get-radius cir))
        (vla-put-radius cir radNew)
        (foreach sub linLst
          (if (equal radOld (distance cen (car sub)) 1e-8)
            (progn
              (vlax-put
                (caddr sub)
                (if (cadr sub) 'startpoint 'endpoint)
                (vlax-curve-getclosestpointto cir (car sub))
              )
              (setq linLst (vl-remove sub linLst))
            )
          )
        )
      )
    )
  )
  (vla-endundomark doc)
  (princ)
)
Never give up !

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2125
  • class keyThumper<T>:ILazy<T>
Re: How to extend or cut?
« Reply #8 on: May 26, 2019, 10:07:35 PM »
Nice solution Roy
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2125
  • class keyThumper<T>:ILazy<T>
Re: How to extend or cut?
« Reply #9 on: May 26, 2019, 10:19:49 PM »

But some CAD is a streamlined version, and a VL-function needs to add a line of code when it runs.

Code - Auto/Visual Lisp: [Select]

That is really nit-picking. Most people who run customisation have the function call in one of theit start-up files.

Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

myloveflyer

  • Newt
  • Posts: 152
Re: How to extend or cut?
« Reply #10 on: May 27, 2019, 04:37:31 AM »

But some CAD is a streamlined version, and a VL-function needs to add a line of code when it runs.

Code - Auto/Visual Lisp: [Select]

That is really nit-picking. Most people who run customisation have the function call in one of theit start-up files.



Thanks,kdub!Thank you for reminding me, I will pay attention to this when I write the program in the future!
Never give up !

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: How to extend or cut?
« Reply #11 on: May 27, 2019, 11:10:01 PM »
Put your (vl-load-com) in your start up lisp then its always loaded.
A man who never made a mistake never made anything