I want to convert many straight lines into one arc.

[BEAR]

I am currently using AutoCAD LT version.
The LT version does not support NETLOAD.
I want to use the LS2A command in the .DLL.
(I want to change to LISP and use it in LT version)

Is there a way?

 

Edited March 7 by BEAR

[SLW210]

Perhaps explain what you need to do and someone could create or know where this is one already.

[BEAR]

Thank you for answer.

I've been looking for something related to this for several days, but couldn't find it, so I posted it like this.

 

Like your answer, I will ask about the method and look for it again.

thank you

[SLW210]

I forgot to move your thread to the AutoLISP, Visual LISP & DCL Forum yesterday. It is now moved, maybe you'll get some help here since you need a LISP.

[Steven P]

So what does LS2A do? What do you want it to do? Quick description would help us to help you.....

[BEAR]

hello

I've searched a lot of Lisps, but there isn't one that has the function I'm looking for, so I'm asking this question...

I wish the numerous lines would turn into one arc.

I will upload example photos and files.

 

 

Thank you for your help.

 

 

[BEAR]

I want to change this collection of straight lines into an arc.

A lot of time was spent working on these arcs.
I'm looking for Lisp.

 

 

[BEAR]

I will also upload an example file.

 

sample.dwg

[mhupp]

You would need to define 3 points to get the radius then use fillet command on the other longer lines. and go back to delete the smaller lines. The hard part is figuring out the "end points" with out user input.

 

proof of concept.

(defun c:foo (/ p1 p2 p3 )
  (setq p1 (getpoint "Select End point Point"))
  (setq p2 (getpoint "Select Mid Point"))
  (setq p3 (getpoint "Select End point Point"))
  (setq line1 (car (entsel "Select line")))
  (setq line2 (car (entsel "Select line")))
  (setvar 'filletrad (3PR p1 p2 p3))
  (command "fillet" line1 line2)
)

;; 3-Point Circle  -  Lee Mac
;; Returns the center (UCS) and radius of the circle defined by three supplied points (UCS).
;; Modified to return only radius
(defun 3PR (pt1 pt2 pt3 / cen md1 md2 vc1 vc2)
    (if (setq md1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2)
              md2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt2 pt3)
              vc1 (mapcar '- pt2 pt1)
              vc2 (mapcar '- pt3 pt2)
              cen (inters md1 (mapcar '+ md1 (list (- (cadr vc1)) (car vc1) 0))
                          md2 (mapcar '+ md2 (list (- (cadr vc2)) (car vc2) 0))
                          nil
                  )
        )
        (distance cen pt1)
    )
)

 

[Steven P]

I guess you want to make this process quicker:

 

Arc command

Select start point

Select mid point

Select end point

Delete existing lines?

[Steven P]

From the quick look I did all the lines in the arcs are the same length, 120 segments to a circle, 30 to a quarter circle. If so then "end point" could be found from that?

 

Just wondering, list all the segment start and end points and the end of the arc there will only be 1 point listed - all the others have 2 points listed, one from each adjacent segment? This should return the end points of lines that are touching. Maybe needs some factor in case they arn't all touching exactly

 

(defun c:uniquepoints ( / MySS MyList acount)
  ;;sub functions
  (defun onlyunique ( MyList / returnList )
    (setq ReturnList (list))                           ; blank list for result
    (foreach n MyList                                  ; loop through supplied list
      (if ( = (member n (cdr (member n MyList))) nil)  ; if list item occurs only once
        (setq ReturnList (append ReturnList (list n))) ; add to list
      )
    ) ; end foreach
    ReturnList
  )
  ;;end sub functions
  (princ "Select Lines")
  (setq MySS (ssget '((0 . "LINE"))))                  ; Select lines only
  (setq MyList (list))                                 ; Blank list for line coordinates
  (setq acount 0)
  (while (< acount (sslength MySS))                    ; loop each line
    (setq MyEnt (entget (ssname MySS acount)))
    (setq MyList (append MyList (list (cdr (assoc 10 MyEnt))))) ; add end A to list
    (setq MyList (append MyList (list (cdr (assoc 11 MyEnt))))) ; add end B to list
    (setq acount (+ acount 1))
  )
  (onlyunique MyList)                                  ; ends A nd B
)

 

I was going to go with select segments, draw arc, delete segments 

Edited February 16 by Steven P

[SLW210]

I merged your threads. No need to create new threads for the same question.

[Steven P]

7 hours ago, mhupp said:

You would need to define 3 points to get the radius then use fillet command on the other longer lines. and go back to delete the smaller lines. The hard part is figuring out the "end points" with out user input.

 

 

 

Just merging our 2 ideas together, kind of works

 

(defun c:foo (/ p1 p2 p3 MyList)
  ;;sub functions
  (defun onlyunique ( MyList / returnList )
    (setq ReturnList (list))                           ; blank list for result
    (foreach n MyList                                  ; loop through supplied list
      (if ( = (member n (cdr (member n MyList))) nil)  ; if list item occurs only once
        (setq ReturnList (append ReturnList (list n))) ; add to list
      )
    ) ; end foreach
    ReturnList
  )
  (defun uniquepoints ( MySS / MyList acount)
    (princ "Select Lines")
    (setq MyList (list))                                 ; Blank list for line coordinates
    (setq acount 0)
    (while (< acount (sslength MySS))                    ; loop each line
      (setq MyEnt (entget (ssname MySS acount)))
      (setq MyList (append MyList (list (cdr (assoc 10 MyEnt))))) ; add end A to list
      (setq MyList (append MyList (list (cdr (assoc 11 MyEnt))))) ; add end B to list
      (setq acount (+ acount 1))
    )
    (list (onlyunique MyList) MyList)                     ; list: Unique Items, All Items
  )

  ;; 3-Point Circle  -  Lee Mac
  ;; Returns the center (UCS) and radius of the circle defined by three supplied points (UCS).
  ;; Modified to return only radius
  (defun 3PR (pt1 pt2 pt3 / cen md1 md2 vc1 vc2)
    (if (setq md1 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2)
              md2 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt2 pt3)
              vc1 (mapcar '- pt2 pt1)
              vc2 (mapcar '- pt3 pt2)
              cen (inters md1 (mapcar '+ md1 (list (- (cadr vc1)) (car vc1) 0))
                          md2 (mapcar '+ md2 (list (- (cadr vc2)) (car vc2) 0))
                          nil
                  )
        )
        (distance cen pt1)
    )
  )                    
  ;;end sub functions

  (setq MyList (uniquepoints (setq MySS (ssget '((0 . "LINE"))))));; SP ADDED
  (setq p1 (car (car MyList)));; SP ADDED
  (setq p2 (nth (/ (length (cadr MyList)) 2) (cadr MyList)));; SP ADDED
  (setq p3 (cadr (car MyList)));; SP ADDED


;  (setq p1 (getpoint "Select End point Point"));;SP Commented out
;  (setq p2 (getpoint "Select Mid Point"));;SP Commented out
;  (setq p3 (getpoint "Select End point Point"));;SP Commented out
  (setq line1 (car (entsel "Select line")))
  (setq line2 (car (entsel "Select line")))
  (setvar 'filletrad (3PR p1 p2 p3))
  (command "fillet" line1 line2)

(command "erase" MySS "") ; delete original lines: SP ADDED

)

 

 

[BEAR]

thank you
I didn't know how to edit or delete the post, so I left it as is.

 

Thank you both so much for your answers.

 

mhupp

The method I want is to change the lines into one arc.
When deleting the line, it is difficult to check whether the same arc was created, and there is a problem in that you have to check each line one by one.

So I think it would be a little difficult for me to use this method.

 

Steven P

The Lisp you answered doesn't work...

I tried reloading and operating it a few times, but there was no response.

 

 

[BEAR]

I will also upload a video of the method I want.

 

I will also upload a video of the method I want.

This file cannot be used in the LT version.
There is a similar method in LISP and I would like to get some help.

 

 

[BEAR]

Steven P It worked similarly when I used the Lisp you just uploaded!!
Is there a way to work with multiple selections?

I'm uploading another video in case it helps.

 

[Steven P]

I think MHUPPS idea is more a proof that his idea works - if the basics work add a little more info and I am sure he will be along as and when he gets chance to update and improve the code.

 

 

I was just about to reply that I had uploaded a second code, a modification of MHUPPs above adding my first snippet of code in there. My first post was just an idea for him but I didn't make that too clear, whoops. The second code builds on what MHUPP did and deletes the original lines. I've followed what he writes for a while now and no doubt if he has a proof of concept here, then he has an idea to improve it for the next stage (he is however busy, depends on the time he has available of course).

 

 

 

 

Multiple selections might be trickier to separate out each arc individually, I'll have a think.

[BEAR]

Thank you for answer

[Steven P]

wahoo! It's the weekend and so CAD is going to sleep.

 

Going to leave this one here for now though it doesn't complete your problem, it is a stepping stone till next time.

 

Running this LISP, select a single line and it will grab all the lines connected to it and return this as a selection set.

 

Just to remind me for later, the next steps here are:

- Split the output of this up into 'long lines' and each segmented arc - the segmented arcs can then run the above codes

- Repeat this over a full drawing

 

Part way there.

 

 

(defun c:ConnectedLines ( / MySS MyList MyLines acount pt pt1 pt2 pt3 pt4)
  (setq MyEnt (car (entsel "Select a line"))) ; A selected line
  (setq ConnectedLines (ssadd MyEnt))         ; List for lines connected to selected
  (setq MyList (ssadd MyEnt))                 ; List for used lines ; Later: for selection set selections
  (setq Pt (cdr (assoc 10 (entget MyEnt))))   ; End A point
  (setq AnEnt MyEnt)                          ; Starting Entity

  (repeat 2                                   ; Repeat2 - both directions
    (setq StopLoop "No")                      ; Marker to stop looping
    (while (= StopLoop "No")
      (setq Pt1 (mapcar '+ '(-0.0001 -0.0001) Pt)); Small area around end of line
      (setq Pt3 (mapcar '+ '( 0.0001  0.0001) Pt)); Other corner
      (setq MySS (ssget "_C" Pt1 Pt3 '((0 . "LINE"))) ) ; select joining lines within 0.0001
      (if (= (sslength MySS) 2)               ; If only 2 joining lines
        (progn
          (setq MySS (ssdel AnEnt MySS))      ; Next line
          (setq AnEnt (ssname MySS 0))        ; next line entity name
          (setq APtA (cdr (assoc 10 (entget AnEnt)))) ; next line end points
          (setq APtB (cdr (assoc 11 (entget AnEnt))))
          (if (ssmemb AnEnt MyList)
            (progn
              (princ "Repeating Selection")
              (setq StopLoop "Yes")
            )
            (progn
              (setq MyList (ssadd MyEnt))         ; List for used lines ; Later: for selection set selections
              (setq ConnectedLines (ssadd AnEnt ConnectedLines)) ; add next line to list of connected lines
              (if (equal APtA Pt 0.0001)
                (setq Pt APtB)(setq Pt APtA)      ; work out if next line connected at end A or B
              )
            )
          )
        ) ; end progn
        (progn
          (setq StopLoop "Yes")
        ) ; end progn
      ) ; end if SSlength = 2
    ) ; end while stoploop

    (setq Pt (cdr (assoc 11 (entget MyEnt))))
    (setq AnEnt MyEnt)
  ) ; end repeat

  (princ "\n")(princ (sslength ConnectedLines))(princ " Connected Lines Found")
  ConnectedLines                              ; Return Connected Lines
)

 

[BIGAL]

Maybe just look at lines that are short and look at next point a none short would be start of a line to be kept. Then work out the radius. Will think about it.