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

Link to comment

Share on other sites

Emmanuel Delay

Link to comment

Share on other sites

Roy_043

Link to comment

Share on other sites

Emmanuel Delay

Link to comment

Share on other sites

myloveflyer

Link to comment

Share on other sites

myloveflyer

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity