Print Page - How to extend or cut？

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: myloveflyer on May 22, 2019, 03:44:25 AM

Title: How to extend or cut？
Post by: myloveflyer 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.

Title: Re: How to extend or cut？
Post by: ronjonp 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:

Title: Re: How to extend or cut？
Post by: myloveflyer on May 23, 2019, 09:26:16 PM

Quote from: ronjonp 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:

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?

Title: Re: How to extend or cut？
Post by: kdub_nz 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.

Title: Re: How to extend or cut？
Post by: BIGAL 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))

Title: Re: How to extend or cut？
Post by: roy_043 on May 25, 2019, 05:56:07 AM

Code - Auto/Visual Lisp: [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))
    )
  )
)
 
(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)
)

Title: Re: How to extend or cut？
Post by: ronjonp on May 26, 2019, 12:36:29 AM

Quote from: roy_043 on May 25, 2019, 05:56:07 AM

Code - Auto/Visual Lisp: [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))
)
)
)

(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)
)

Nice 8-)

Title: Re: How to extend or cut？
Post by: myloveflyer on May 26, 2019, 09:07:25 PM

Quote from: roy_043 on May 25, 2019, 05:56:07 AM

Code - Auto/Visual Lisp: [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))
)
)
)

(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)
)

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)
)

Title: Re: How to extend or cut？
Post by: kdub_nz on May 26, 2019, 10:07:35 PM

Nice solution Roy

Title: Re: How to extend or cut？
Post by: kdub_nz on May 26, 2019, 10:19:49 PM

Quote from: myloveflyer on May 26, 2019, 09:07:25 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]
(vl-load-com)

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

Title: Re: How to extend or cut？
Post by: myloveflyer on May 27, 2019, 04:37:31 AM

Quote from: kdub on May 26, 2019, 10:19:49 PM

Quote from: myloveflyer on May 26, 2019, 09:07:25 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]
(vl-load-com)

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!

Title: Re: How to extend or cut？
Post by: BIGAL on May 27, 2019, 11:10:01 PM

Put your (vl-load-com) in your start up lisp then its always loaded.

TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: myloveflyer on May 22, 2019, 03:44:25 AM