Change the diameter of the circle

August 13, 2019

This app was written by a friend of the forum. The program now has a problem by changing the diameter of the circle to lengthen or shorten the length of the line between the circles. It is not dealing with slashes. I am not familiar with the VLAX feature. Which friend can help me solve this problem? thank you for your help!

;;;by roy_043
(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)
)

Edited August 13, 2019 by myloveflyer

August 13, 2019

Some of the lines don't touch the circles exactly, so I'll have to make a intersect_approximately function.

Then again, I can use that function to trim/expand the lines after the circles change radius, so that's okay.

I'll see what I can do

August 13, 2019

FYI: the OP has posted the same issue here:

https://www.theswamp.org/index.php?topic=55371.0

Edited August 13, 2019 by Roy_043

August 13, 2019

This should work.

Command ALTR (for Adapt Lines To Radius)


(vl-load-com)

;; Get the closest points of a line to two circles
;; line: normal entity
;; curvyobjects: ssget (/ ssadd) selection
;; return (list index_start index_end)  ;; index of the circle ss selection
(defun line_closest_points_to_circles (line curvyobjects / i ps pe p1 p2 dist_start dist_end ind_s ind_e )
      ;; start and endpoint of line
      (setq ps (cdr (assoc 10 (entget line))))
      (setq pe (cdr (assoc 11 (entget line))))
      ;; random big number, we hope to find something better
      (setq dist_start 100000000)
      (setq dist_end 100000000)

      (setq i 0)
      (repeat (sslength curvyobjects)

        (setq p1 (vlax-curve-getClosestPointTo   (ssname curvyobjects i)   ps   T))
        (setq p2 (vlax-curve-getClosestPointTo  (ssname curvyobjects i)  pe   T))
       
        ;; see which is closest, start or end
        ;; then see if it's better than the previous dist_start and dist_end
        (if
          (< (distance p1 ps) (distance p2 pe))  
          (progn
            (if
              (< (distance p1 ps) dist_start)
              (progn
                 (setq dist_start (distance p1 ps))
                 (setq ind_s i)
              )
            )
          )
          (progn
            (if
              (< (distance p2 pe) dist_end)
              (progn
                 (setq dist_end (distance p2 pe))
                 (setq ind_e i)
              )
            )
          )
        )
        
        (setq i (+ i 1))
      )
      
      (list ind_s ind_e)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun setOverride (obj override_assoc override_val / a b)
  (setq a (entget obj))
  (setq b (assoc override_assoc a))
  (setq c (cons override_assoc override_val))
  (setq a (subst c b a))
  (entmod a)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; altr for Adapt Lines To Radius
(defun c:altr ( / i j ss radNew lines circles itemdata linesdata ps pe p1 p2  )
  (if
    (and
      (setq ss (ssget '((0 . "LINE,CIRCLE"))))
      T
    )
    (progn
      ;; let's distinguish the lines and the circles in separate selections
      (setq lines (ssadd))
      (setq circles (ssadd))
      (setq i 0)
      (repeat (sslength ss)
        (if  (= "CIRCLE" (cdr (assoc 0 (entget (ssname ss i)))))
          (ssadd (ssname ss i) circles)
        )
        (if  (= "LINE" (cdr (assoc 0 (entget (ssname ss i)))))
          (ssadd (ssname ss i) lines)
        )
        (setq i (+ i 1))
      )
      ;; linesdata will keep track of which circles (its index) are attached to each line.
      ;;
      (setq linesdata (list))
      (setq i 0)
      ;; search for intersections of each line with two circles
      (repeat (sslength lines)
        (setq itemdata  (line_closest_points_to_circles (ssname lines i) circles ) )
        (setq linesdata (append linesdata (list itemdata )))
        (setq i (+ i 1))
      )
      
      ;; now that we establishd the partners, for each line the index of 2 circles
      ;; we can alter the radius

        (while
          (setq radNew (getreal "\nSet New radius: "))
          
          ;; Change the radius of the circles
          (setq i 0)
          (repeat (sslength circles)
            (setOverride  (ssname circles i) 40 radNew)
            (setq i (+ i 1))
          )

          ;; Change the start and end of the lines
          (setq i 0)
          (repeat (sslength lines)
            ;; start point
            (setq ps (cdr (assoc 10 (entget  (ssname lines i)))))
            (setq p1 (vlax-curve-getClosestPointTo   (ssname circles (nth 0 (nth i linesdata)))   ps   T))
            (setOverride  (ssname lines i) 10 p1)
            ;; end point
            (setq pe (cdr (assoc 11 (entget  (ssname lines i)))))
            (setq p2 (vlax-curve-getClosestPointTo   (ssname circles (nth 1 (nth i linesdata)))   pe   T))
            (setOverride  (ssname lines i) 11 p2)

            (setq i (+ i 1))
          )
          
        )
    )
  )
  (princ)
)

August 14, 2019

8 hours ago, Emmanuel Delay said:

This should work.

Command ALTR (for Adapt Lines To Radius)


(vl-load-com)

;; Get the closest points of a line to two circles
;; line: normal entity
;; curvyobjects: ssget (/ ssadd) selection
;; return (list index_start index_end)  ;; index of the circle ss selection
(defun line_closest_points_to_circles (line curvyobjects / i ps pe p1 p2 dist_start dist_end ind_s ind_e )
      ;; start and endpoint of line
      (setq ps (cdr (assoc 10 (entget line))))
      (setq pe (cdr (assoc 11 (entget line))))
      ;; random big number, we hope to find something better
      (setq dist_start 100000000)
      (setq dist_end 100000000)

      (setq i 0)
      (repeat (sslength curvyobjects)

        (setq p1 (vlax-curve-getClosestPointTo   (ssname curvyobjects i)   ps   T))
        (setq p2 (vlax-curve-getClosestPointTo  (ssname curvyobjects i)  pe   T))
       
        ;; see which is closest, start or end
        ;; then see if it's better than the previous dist_start and dist_end
        (if
          (< (distance p1 ps) (distance p2 pe))  
          (progn
            (if
              (< (distance p1 ps) dist_start)
              (progn
                 (setq dist_start (distance p1 ps))
                 (setq ind_s i)
              )
            )
          )
          (progn
            (if
              (< (distance p2 pe) dist_end)
              (progn
                 (setq dist_end (distance p2 pe))
                 (setq ind_e i)
              )
            )
          )
        )
        
        (setq i (+ i 1))
      )
      
      (list ind_s ind_e)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun setOverride (obj override_assoc override_val / a b)
  (setq a (entget obj))
  (setq b (assoc override_assoc a))
  (setq c (cons override_assoc override_val))
  (setq a (subst c b a))
  (entmod a)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; altr for Adapt Lines To Radius
(defun c:altr ( / i j ss radNew lines circles itemdata linesdata ps pe p1 p2  )
  (if
    (and
      (setq ss (ssget '((0 . "LINE,CIRCLE"))))
      T
    )
    (progn
      ;; let's distinguish the lines and the circles in separate selections
      (setq lines (ssadd))
      (setq circles (ssadd))
      (setq i 0)
      (repeat (sslength ss)
        (if  (= "CIRCLE" (cdr (assoc 0 (entget (ssname ss i)))))
          (ssadd (ssname ss i) circles)
        )
        (if  (= "LINE" (cdr (assoc 0 (entget (ssname ss i)))))
          (ssadd (ssname ss i) lines)
        )
        (setq i (+ i 1))
      )
      ;; linesdata will keep track of which circles (its index) are attached to each line.
      ;;
      (setq linesdata (list))
      (setq i 0)
      ;; search for intersections of each line with two circles
      (repeat (sslength lines)
        (setq itemdata  (line_closest_points_to_circles (ssname lines i) circles ) )
        (setq linesdata (append linesdata (list itemdata )))
        (setq i (+ i 1))
      )
      
      ;; now that we establishd the partners, for each line the index of 2 circles
      ;; we can alter the radius

        (while
          (setq radNew (getreal "\nSet New radius: "))
          
          ;; Change the radius of the circles
          (setq i 0)
          (repeat (sslength circles)
            (setOverride  (ssname circles i) 40 radNew)
            (setq i (+ i 1))
          )

          ;; Change the start and end of the lines
          (setq i 0)
          (repeat (sslength lines)
            ;; start point
            (setq ps (cdr (assoc 10 (entget  (ssname lines i)))))
            (setq p1 (vlax-curve-getClosestPointTo   (ssname circles (nth 0 (nth i linesdata)))   ps   T))
            (setOverride  (ssname lines i) 10 p1)
            ;; end point
            (setq pe (cdr (assoc 11 (entget  (ssname lines i)))))
            (setq p2 (vlax-curve-getClosestPointTo   (ssname circles (nth 1 (nth i linesdata)))   pe   T))
            (setOverride  (ssname lines i) 11 p2)

            (setq i (+ i 1))
          )
          
        )
    )
  )
  (princ)
)

Thanks,Emmanuel!

The program runs very well,The program is running very well, thank you for your help, cheers！

August 14, 2019

12 hours ago, Roy_043 said:

FYI: the OP has posted the same issue here:

https://www.theswamp.org/index.php?topic=55371.0

Thank You Very Much！Roy!

According to your tolerance recommendations, the modified program will perform perfectly, cheers

Sign In

Change the diameter of the circle

Recommended Posts

myloveflyer

Emmanuel Delay

Roy_043

Emmanuel Delay

myloveflyer

myloveflyer

Join the conversation

Tutorials

Forums

Activity