Center line for circles,slots etc.

[Anonymous]

Hi everyone,

I wonder if you could help me with this lisp , it will save me a lot of time:

http://www.imagehost.co.il/view.php?filename=252017_04_04_10_01_19.jpg

first I want to pick a polyline ( it can be a CIRCLE , SLOT ,RECTANGLE , with any angle) ,

then it will ask for line extension dimension ( for example 5mm , as shown in the picture attached)

and it will make a center lines with the extension as specified , the center line should be as shown in the pic , dashed dot , and layer named "center line"

color red.

It's important that program will identify the position , means that if the rectangle or the slot is with angle ( like shown in the pic) it will draw the center line aligned.

Thank you very much in advance.

[dennis]

You could upgrade to AutoCAD 2018: New Feature Center Mark and Centerlines

https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2018/ENU/AutoC...

[Kent1Cooper]

---

@Anonymous wrote:

.... 

first I want to pick a polyline ( it can be a CIRCLE , SLOT ,RECTANGLE , with any angle) ,

then it will ask for line extension dimension ( for example 5mm , as shown in the picture attached)

and it will make a center lines with the extension as specified , the center line should be as shown in the pic , dashed dot , and layer named "center line"

color red.

.... 

---

Give this a try.  It doesn't yet have *error* handling, or suppress command echoing, or save the current Layer first and restore it later, or deal with different Coordinate Systems, etc., etc., but it seems to work.

(defun C:CLM ; = Center Line Marks
  (/ ss n ent edata pt1 ctr rad pt2 pt3 pt4)
  (command "_.layer" "_make" "CENTER LINE" "_color" "1" "" "_ltype" "DASHDOT" "" "")
  (if
    (setq ss
      (ssget
        '(
          (-4 . "<OR")
            (0 . "CIRCLE")
            (-4 . "<AND")
              (0 . "LWPOLYLINE")
              (90 . 4); 4 vertices
              (-4 . "&") (70 . 1); closed
            (-4 . "AND>")
          (-4 . "OR>")
        ); '
      ); ssget
    ); setq
    (progn ; then
      (setq *CLMext*
        (cond
          ( (getdist
              (strcat
                "\nLength of Center Line extensions past perimeter <"
                (rtos (cond (*CLMext*) (5))); in current Units mode/precision
                ">: "
              ); strcat
            ); getdist
          ); User-input condition
          (*CLMext*); on Enter with prior value
          (5); on Enter without prior value [first use]
        ); cond
      ); setq
      (repeat (setq n (sslength ss))
        (setq ent (ssname ss (setq n (1- n))))
        (if (= (cdr (assoc 0 (setq edata (entget ent)))) "CIRCLE")
          (setq ; then
            pt1 (polar (setq ctr (cdr (assoc 10 edata))) 0 (setq rad (cdr (assoc 40 edata))))
            pt2 (polar ctr (/ pi 2) rad)
            pt3 (polar ctr pi rad)
            pt4 (polar ctr (* pi 1.5) rad)
          ); setq
          (setq ; else -- LWPolyline
            pt1 (vlax-curve-getPointAtParam ent 0.5)
            pt2 (vlax-curve-getPointAtParam ent 1.5)
            pt3 (vlax-curve-getPointAtParam ent 2.5)
            pt4 (vlax-curve-getPointAtParam ent 3.5)
          ); setq
        ); if
        (command
          "_.line"
          "_none" (polar pt1 (angle pt3 pt1) *CLMext*)
          "_none" (polar pt3 (angle pt1 pt3) *CLMext*)
          ""
          "_.line"
          "_none" (polar pt2 (angle pt4 pt2) *CLMext*)
          "_none" (polar pt4 (angle pt2 pt4) *CLMext*)
          ""
        ); command
      ); repeat
    ); progn
  ); if
  (princ)
); defun

NOTE that it filters only for Circles and closed 4-segment Polylines.  In the case of the latter, it will work with any like that -- it does not evaluate whether they are slot- or rectangle-shaped, but draws the Lines across the midpoints of the 4 segments, however they may be arranged, as in the right side of the image.  It could be made to check for that kind of thing, if desired.

[pbejse]

---

@Kent1Cooper wrote:

(defun C:CLM ; = Center Line Marks
.......
          (setq ; else -- LWPolyline
            pt1 (vlax-curve-getPointAtParam ent 0.5)
            pt2 (vlax-curve-getPointAtParam ent 1.5)
            pt3 (vlax-curve-getPointAtParam ent 2.5)
            pt4 (vlax-curve-getPointAtParam ent 3.5)
.......

---

Nice 

 

[Anonymous]

WoW !! Kent Cooper,

You're great! 

thank you very very much this lisp will save me a lot of time.

Eyal.