Jump to content

Circles at the end of lines and trim around

teknomatika

By teknomatika
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

teknomatika Rising Star

teknomatika

Posted
Posted

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

Link to comment
Share on other sites
  • Replies 50
  • Created
  • Last Reply

Top Posters In This Topic

  • teknomatika

    19

  • Trudy

    18

  • alanjt

    5

  • BIGAL

    3

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

alanjt
alanjt

Here's someone using their head.

Trudy
Trudy

I modify a little, because i find a problem when all lines ar duplicated. This is the new. ;Create from Georgi Georgiev - TRUDY ;Date 11.10.2020 (defun c:try1 ( / A BR BRR DELLST EMPLAY ENT I

Posted Images

teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

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

Link to comment
Share on other sites
Trudy Collaborator

Trudy

Posted
Posted (edited)

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 by Trudy
Link to comment
Share on other sites
Dadgad Grand Master

Dadgad

Posted
Posted

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!   :beer:

 

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

Link to comment
Share on other sites
Trudy Collaborator

Trudy

Posted
Posted (edited)

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 by Trudy
Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

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 by BIGAL
Link to comment
Share on other sites
Trudy Collaborator

Trudy

Posted
Posted (edited)

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 by Trudy
Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted
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

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted
21 minutes ago, Trudy said:

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

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

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted
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!

 

 

 

Link to comment
Share on other sites
Trudy Collaborator

Trudy

Posted
Posted

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)

)

 

Link to comment
Share on other sites
alanjt Grand Master

alanjt

Posted
Posted

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)

 

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

@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. ;) 

 

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

@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
 

 

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...