Circles at the end of lines and trim around

October 6, 2020

I return to the forum to ask for help.
I need a routine that inserts a circle of radius into all line endpints.
The radius of the circle must be defined by the operator.
Once the routine is inserted, you should trim all lines to the extent defined by the circles.
The circles must be integrated in their own layer to be controllable.
Any help will be appreciated.

An example drawing follows.

Thank you in advance.

teste_cadtutor_06102020.dwg

October 6, 2020

In the meantime I found this routine by the master BIGAL and solves partly what I want

but not entirely since it does not act on the lines intercepted by the circles.

https://www.cadtutor.net/forum/topic/37907-how-trim-many-line-inside-multi-circle-on-one-step/page/2/#comments
;;By BIGAL
;vl version
(defun c:tric ( / ss x c1)
(setq ss (ssget (list (cons 0 "Circle"))))
(repeat (setq x (sslength ss))
(setq c1 (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq cenpt (vlax-safearray->list (vlax-variant-value (vla-get-center c1))) )
(command "trim" (vlax-vla-object->ename c1) "" cenpt "")
) ; repeat
) ;defun

An example drawing follows.

teste_cadtutor_06102020_2.dwg

October 6, 2020

This work with end of line only for now, when i go home i will finish it.

But you say if this work for you.

The code for trim in circle is from https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/inside-circle-trim-routine-lisp/td-p/7110244

(defun c:try1 ()
(vl-load-com)
(defun Circle (cen rad)
  (entmakex (list (cons 0 "CIRCLE")
                  (cons 10 cen)
                  (cons 40 rad)
			)
	)
)
(setq listt nil)
(setq radd (getreal "\n RADIUSSSSS: "))
(setq sel1 (ssget "X" '((0 . "line"))))
	(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
			(Circle (cdr (assoc 11 ent)) radd)	
	)
(princ lis)
(setq old-os (getvar "osmode"))
(setvar "osmode" 0)

(setq sset (ssget "X" (list (cons 0 "CIRCLE"))))
(setq n 0)

(repeat (sslength sset)
(setq obj (ssname sset n))
(setq obj1 (vlax-ename->vla-object obj))
(setq cen (vlax-safearray->list (vlax-variant-value (vla-get-center obj1))))
(setq rad (vla-get-radius obj1))
(setq p 0)

(defun DTR (ang)
	(* PI (/ ang 180.0))
);defun DTR

(setq ang 0)

(repeat 20
	(setq p1 cen)
	(setq p2 (polar p1 (DTR ang) rad))
	(command "trim" obj "" "f" p1 p2 "" "")
	(setq ang (1+ ang))
);repeat


;(repeat 360
;	(setq p1 cen)
;	(setq p2 (polar p1 (DTR ang) (- rad (* 0.1 rad))))
;	(command "erase" "f" p1 p2 "" "")
;	(setq ang (1+ ang))
;);repeat

(setq n (1+ n))
);repeat



(princ)
;(*error*)

);defun

Edited October 6, 2020 by Trudy

October 6, 2020

I am not sure if I understand you correctly, or not.

Thinking that if you change the ratio to1.0 from 1.5 you might be good to go.

When in doubt check LeeMac out.

http://www.lee-mac.com/associativecenterlines.html

Thanks Lee!

It is awesome, I used to use it all the time before switching to ProSteel.

October 6, 2020

I think this is.

Say if you want something to change/

;Create from Georgi Georgiev - TRUDY
;Date 06.10.2020
(defun c:try1 ()
(vl-load-com)
(load "extrim")
(setvar "osmode" 0)
(defun Circle (cen rad)
  (entmakex (list (cons 0 "CIRCLE")
                  (cons 8 "manipulate_circle")
                  (cons 10 cen)
                  (cons 40 rad)
			)
	)
)
(setq listt nil)
(setq listt2 nil)
(setq list3 nil)
(setq list4 nil)

(setq radd (getreal "\nRADIUSSSSS: "))
(setq sel1 (ssget "X" '((0 . "line"))))
	(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
		(setq listt (cons (cdr (assoc 11 ent)) listt))
		(setq listt2 (cons (cdr (assoc 10 ent)) listt2))
			
	)
(setq list3 (append listt listt2))

	(while list3
		(setq list4 (cons (car list3) list4))
		(setq list3 (vl-remove (car list3) list3))
	)

	(repeat (length list4)
		(Circle (car list4) radd)
		(setq list4 (cdr list4))
	)

(setq sset (ssget "X" (list (cons 0 "CIRCLE"))))

(if sset
	(repeat (setq n (sslength sset))
		(setq obj (ssname sset 		(setq n (1- n))))
		(etrim obj (cdr (assoc 10 (entget obj))))

	)
)

(princ)

)

Edited October 6, 2020 by Trudy

October 6, 2020

Trudy,

Thank you for your interest and help.

An error occurs:
; error: no function definition: ETRIM

October 6, 2020

Try it now i was forgot "(load "extrim")"

October 6, 2020

Trudy you can reduce the code a lot as your doing a selection set of the lines, then entmake the circle at start then use etrim, do the code again for other end no need to make lists.

Please note if your using Bricscad it does not have a extrim but you can use extrim.lsp from Autocad. Else can do your own version of etrim using trim and "F" fence option with a little polygon inside the circle say radd/2 another problem is polygon is different between Autocad and Bricscad.

;Create from Georgi Georgiev - TRUDY
;Date 06.10.2020
; modified by Alanh 07.10.2020

(defun c:try1 ( / circle ent end start sel1 oldsnap)
; (vl-load-com) not needed as no VL code.
(load "extrim")
(setq oldsnap (getvar 'osmode))
(setvar "osmode" 0)
(defun Circle (cen rad)
  (entmakex (list (cons 0 "CIRCLE")
                  (cons 8 "manipulate_circle")
                  (cons 10 cen)
                  (cons 40 rad)
			)
	)
)


(setq radd (getreal "\nRADIUSSSSS: "))

(setq sel1 (ssget "X" '((0 . "line"))))
	(repeat (setq i (sslength sel1))
		(setq ent (entget (ssname sel1 (setq i (1- i)))))
		(setq end (cdr (assoc 11 ent)))
		(setq start (cdr (assoc 10 ent)))
		(circle start radd)
		(etrim (entlast) start)
		(circle end radd)
		(etrim (entlast) end)
	)
(setvar 'osmode oldsnap)

(princ)

)

Edited October 6, 2020 by BIGAL

October 7, 2020

Hello BIGAL i see what you modify but in some intersect points we have 2 or more circles and result is different.

I create a list of points and remove duplicate points.
I dont know how Bricscad work but if someone needs trim lisp can check https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/inside-circle-trim-routine-lisp/td-p/7110244 .

Edited October 7, 2020 by Trudy

October 7, 2020

14 hours ago, Trudy said:

Thank for your help.
From the tests I performed, it seems to be working, but in some situations the routine produces two circles when in reality there was only one end of the line.
On the other hand, I wanted the routine to execute on a selection and not on the whole drawing.

teste_cadtutor_06102020_3.dwg

October 7, 2020

Okayy i will modify but can you uppload some real drawing because its hard with test

Other i think if lines not snap.

October 7, 2020

21 minutes ago, Trudy said:

Ok, eu vou modificar, mas você pode carregar algum desenho real porque é difícil com o teste

Outros eu acho que se as linhas não se encaixarem.

Trudy,

Ok. I attach two files, one before and one after the routine action.
You will see that some lines are overlapping but it is still so.

cadtutor_07102020_after.dwg cadtutor_07102020_before.dwg

October 7, 2020

Hello, teknomatika

This is result when i start the lisp.

October 7, 2020

Hello, teknomatika

Which lisp do you use only my or this where is modify from Alanh.

(try with my lisp)

October 7, 2020

24 minutes ago, Trudy said:

Hello, teknomatika

Which lisp do you use only my or this where is modify from Alanh.

(try with my lisp)

Trudy,

I went back to testing and in fact it didn't happen.
However, I see that when circles overlap, they are also affected by trim.
Although as it is already satisfying what I want, it would be interesting that the circles were preserved without trim.

Thanks for help!

October 7, 2020

I modify select, but don't know will it work for you.
I am glad to help.

;Create from Georgi Georgiev - TRUDY
;Date 06.10.2020
(defun c:try1 ()
(vl-load-com)
(load "extrim")
(setvar "osmode" 0)
(defun Circle (cen rad)
  (entmakex (list (cons 0 "CIRCLE")
                  (cons 8 "manipulate_circle")
                  (cons 10 cen)
                  (cons 40 rad)
			)
	)
)
(setq listt nil)
(setq listt2 nil)
(setq list3 nil)
(setq list4 nil)

(setq radd (getreal "\nRADIUSSSSS: "))
(Princ (strcat "\r Select lines "))
(setq sel1 (ssget '((0 . "line"))))
	(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
		(setq listt (cons (cdr (assoc 11 ent)) listt))
		(setq listt2 (cons (cdr (assoc 10 ent)) listt2))
			
	)
(setq list3 (append listt listt2))

	(while list3
		(setq list4 (cons (car list3) list4))
		(setq list3 (vl-remove (car list3) list3))
	)

	(repeat (length list4)
		(Circle (car list4) radd)
		(setq list4 (cdr list4))
	)
(Princ (strcat "\r Select circles "))
(setq sset (ssget (list (cons 0 "CIRCLE"))))

(if sset
	(repeat (setq n (sslength sset))
		(setq obj (ssname sset 		(setq n (1- n))))
		(etrim obj (cdr (assoc 10 (entget obj))))

	)
)

(princ)

)

October 7, 2020

This was an interesting morning exercise. I'm definitely awake now.

(defun c:COL (/ *error* _flatDist circleLayer u ss i oLst int copy p pLst cLst)
  ;; https://www.cadtutor.net/forum/topic/71294-circles-at-the-end-of-lines-and-trim-around/


  (setq circleLayer "CIRCLES")


  (defun *error* (msg)
    (and u (vla-endundomark *AcadDoc*))
    (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
      (progn (vl-bt) (princ (strcat "\nError: " msg)))
    )
  )


  (defun _flatDist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

  (princ "\nSelect lines to draw circles at endpoints: ")

  (if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
           (progn (initget 6)
                  (setq *COL:Radius*
                         (cond
                           ((getdist (strcat "\nSpecify circle radius"
                                             (if *COL:Radius*
                                               (strcat " <" (rtos *COL:Radius*) ">: ")
                                               ": "
                                             )
                                     )
                            )
                           )
                           (*COL:Radius*)
                         )
                  )
           )
      )
    (progn

      (setq u (not (vla-startundomark
                     (cond (*AcadDoc*)
                           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                     )
                   )
              )
      )

      ;; list of lines
      (repeat (setq i (sslength ss))
        (setq oLst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) oLst))
      )

      ;; "break" intersecting lines
      (foreach obj oLst
        (foreach o oLst
          (if (and (setq int (vlax-invoke obj 'IntersectWith o acExtendNone))
                   (not (member int (mapcar 'vlax-get (list obj obj) '("StartPoint" "EndPoint"))))
              )
            (if (> (_flatDist int (vlax-get obj 'StartPoint))
                   (_flatDist int (vlax-get obj 'EndPoint))
                )
              (progn
                (vlax-put (setq copy (vla-copy obj)) 'StartPoint int)
                (vlax-put obj 'EndPoint int)
                (setq oLst (cons copy oLst))
              )
              (progn
                (vlax-put (setq copy (vla-copy obj)) 'EndPoint int)
                (vlax-put obj 'StartPoint int)
                (setq oLst (cons copy oLst))
              )
            )
          )
        )
      )

      ;; create circles
      (foreach o oLst
        (foreach prop '("StartPoint" "EndPoint")
          (if (not (progn (setq p (vlax-get o prop))
                          (vl-some (function (lambda (x) (equal p x 0.001))) pLst)
                   )
              )
            (setq cLst (cons (vlax-ename->vla-object
                               (entmakex (list '(0 . "CIRCLE") (cons 8 circleLayer) (cons 10 p) (cons 40 *COL:Radius*)))
                             )
                             cLst
                       )
                  pLst (cons p pLst)
            )
          )
        )
      )

      ;; "trim" lines at intersecting circles
      (foreach c cLst
        (foreach o oLst
          (if (setq int (vlax-invoke c 'IntersectWith o acExtendNone))
            (vlax-put
              o
              (if (> (_flatDist (vlax-get o 'StartPoint) int)
                     (_flatDist (vlax-get o 'EndPoint) int)
                  )
                'EndPoint
                'StartPoint
              )
              int
            )
          )
        )
      )

    )
  )

  (*error* nil)
  (princ)
)
(vl-load-com)
(princ)

October 7, 2020

@alanjt If a line penetrates one of your created circles then the vla-IntersectWith will return two appended list of coordinates which will throw an error due to extra coordinates.

October 7, 2020

@Trudy,

The selection option, I had already managed to solve.
It's the same.

(setq sel1 (ssget '((0 . "line"))))

I am grateful for the interest and help.

@Alan

Thanks for the interest.

when running your version , draws the circles but returns an error.

Error: AutoCAD.Application: Incorrect number of elements in SafeArray

October 7, 2020

Did we solve your problem teknomatika .

Or need more modifying

Sign In

Circles at the end of lines and trim around

Recommended Posts

teknomatika

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

alanjt

Trudy

Posted Images

teknomatika

Trudy

Dadgad

Trudy

teknomatika

Trudy

BIGAL

Trudy

teknomatika

Trudy

teknomatika

Trudy

Trudy

teknomatika

Trudy

alanjt

Tharwat

teknomatika

Trudy

Join the conversation

alanjt

Trudy

Tutorials

Forums

Activity