lisp AutoLISP for Auto creation points for the Selected set at its Endpoints, Midpoints, Center, Geometric center, Node, Quadrant, Intersection & Insertion.

[Pranesh Rathinam]

Hello guys,
I am working in AutoCAD.
I am looking for a combined LISP code for creating points for the selected objects at its Endpoints, Midpoints, Center, Geometric center, Node, Quadrant, Intersection & Insertion as per users requirements (options with drop down list mentioning Endpoints, Midpoints, Center, Geometric center, Node, Quadrant, Intersection & Insertion Shall get prompted.)
Once I select the required snap then the result shall be creation of points at the chosen object snap.

An imaginary Example shall be Like like this,
command: POBS(Points at Object Snap)-->prompting for what snap need to be found in the selected objects in the for of drop down list--> Creating points in the selected Object Snaps of the selection set.

Actually i had found few LISP codes for the following cases

1.PLE-Points on Line Ends.lsp

2.PAI-Point At Intersection.lsp
Thanks for the authors of these above LISP they have saved lot of time till date.

Thanks in advance.

Edited June 1, 2023 by Pranesh Rathinam

[BIGAL]

Ok you need something like this so you can toggle on the desired snaps as 1st question. The second part is does object have all those snaps ? I have 2 programs so start learning, get the Multi toggles to work 1st. its returns a list of on and off buttons that matches your osnaps ("0" "0" "1" "0") so you compare a list of snaps to the on or off buttons.

 

 

The second program Pline line arc props allows you to get properties of an object based on known properties, the mid point would need to be added. 

Multi toggles.lsp

Pline line arc props.lsp

[Pranesh Rathinam]

Hello Bigal,
Thanks for your valuable reply,
I am actually totally new to AutoLISP,
But with your words of try learning the  LISP, i tried coding the LISP for the command PAS-Point at snap with the help of the following functionalities 
AH:Toggs, Multiple toggles.lsp, cords selectedKeys, AH:chkcwccw selectedKeys, plprops selectedKeys, lineprops selectedKeys, 
circprops selectedKeys & arcprops selectedKeys 
Given by you. Thanks once again for motivating to learn LISP programming.

Now i have somewhere ended up like this with respect to the PAS LISP code

 

; Multi toggle Dialog box for multi choice 
; By Alan H Oct 2019

; Example code 
; (if (not AH:Toggs)(load "Multiple toggles.lsp"))
; (setq ans (reverse (ah:toggs   '("Yes or No" "Yes" "No"))))

; (if (not AH:Toggs)(load "Multiple toggles.lsp"))
; (setq ans (reverse (ah:toggs   '("A B C D" "A" "B" "C" "D"))))

; (if (not AH:Toggs)(load "Multiple toggles.lsp"))
; (setq ans (reverse  (ah:toggs '("Choose a number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"))))

(defun mkv_lst ( / )
(setq v_lst '())
(setq x 1)
(repeat (- (length ahbutlst) 1)
(setq val (strcat "Tb" (rtos x 2 0)))
(setq v_lst (cons (get_tile val) v_lst))
(setq x (+ x 1))
)
)

(vl-load-com)
(defun AH:Toggs (ahbutlst / fo fname x  y keylst keynum v_lst)

(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line  "AHtoggles : dialog     {" fo)
(write-line  (strcat "    label =" (chr 34) (nth 0 ahbutlst) (chr 34) " ;" )fo)
(write-line "    : column    {" fo)
(setq x 1)
(repeat (- (length ahbutlst) 1) 
(write-line "    : toggle    {" fo)
(write-line "alignment = left ;"  fo)
(write-line  (strcat "key = "  (chr 34) "Tb" (rtos x 2 0)  (chr 34) ";") fo)
(write-line  (strcat "label = " (chr 34) (nth x  ahbutlst) (chr 34) ";") fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(setq x (+ x 1))
)
(write-line "spacer_1 ;" fo)
(write-line "    ok_cancel;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(close fo)

(setq dcl_id (load_dialog fname))
(if (not (new_dialog "AHtoggles" dcl_id) )
(exit)
)

(setq y 0)
(repeat (- (length ahbutlst) 1)
    (setq keynum (strcat "Tb" (rtos (setq y (+ Y 1)) 2 0)))
    (set_tile keynum "0")
    (mode_tile keynum 3)
)

(action_tile "accept" "(mkv_lst)(done_dialog)")

(action_tile "cancel" "(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete fname)
(princ v_lst)
)

; properties use as a library function
; By Alan H july 2020

(defun cords (obj / co-ords xy )
(setq coordsxy '())
(setq co-ords (vlax-get obj 'Coordinates))
(setq numb (/ (length co-ords) 2))
(setq I 0)
(repeat numb
(setq xy (list (nth (+ I 1) co-ords)(nth I co-ords) ))
(setq coordsxy (cons xy coordsxy))
(setq I (+ I 2))
)
)

(defun AH:chkcwccw (obj / lst newarea)
(setq lst (CORDS obj))
(setq newarea
(/ (apply (function +)
            (mapcar (function (lambda (x y)
                                (- (* (car x) (cadr y)) (* (car y) (cadr x)))))
                    (cons (last lst) lst)
                    l)) 
2.)
)
(if (< newarea  0)
(setq cw "F")
(setq cw "T")
)
)

; Can use reverse in Autocad - pedit reverse in Bricscad.

(defun plprops (obj txt / lst)
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vla-get-layer obj)))
((= (strcase val) "AREA")(setq area (vla-get-area obj)))
((= (strcase val) "START")(setq start (vlax-curve-getstartpoint obj)))
((= (strcase val) "END" (strcase txt))(setq end (vlax-curve-getendpoint obj)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Length)))
((= (strcase val) "CW" (strcase txt))(AH:chkcwccw obj))
((= (strcase val) "CORDS" (strcase txt))(CORDS obj))
)
)
)

(defun lineprops (obj lst / )
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "START")(setq start (vlax-get obj 'startpoint)))
((= (strcase val) "END" (strcase txt))(setq end (vlax-get obj 'endpoint)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Length)))
)
)
)

(defun circprops (obj lst / )
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'Circumference)))
((= (strcase val) "RAD" (strcase txt))(setq rad (vla-get-radius obj)))
((= (strcase val) "CEN" (strcase txt))(setq cen (vlax-get obj 'Center)))
((= (strcase val) "AREA" (strcase txt))(setq end (vlax-get obj 'AREA)))
)
)
)

(defun arcprops (obj txtlst)
(foreach val lst
(cond
((= (strcase val)  "LAY") (setq lay (vlax-get obj 'layer)))
((= (strcase val) "LEN" (strcase txt))(setq len (vlax-get obj 'length)))
((= (strcase val) "RAD" (strcase txt))(setq rad (vla-get-radius obj)))
((= (strcase val) "CEN" (strcase txt))(setq cen (vlax-get obj 'Center)))
((= (strcase val) "START" (strcase txt))(setq area (vlax-get obj 'startpoint)))
((= (strcase val) "END" (strcase txt))(setq area (vlax-get obj 'endpoint)))
((= (strcase val) "AREA" (strcase txt))(setq end (vlax-get obj 'AREA)))
)
)
)

; starts here
(setq ent (vlax-ename->vla-object (car (entsel "Pick Object "))))
; do a check for object type then use defun
; pick an example below

; many examples copy to command line for testing mix and match 
; (plprops ent '("LAY"))(princ lay)
; (plprops ent '("END"))(princ end)
; (plprops ent '("START"))(princ start)
; (plprops ent '("END" "START"))(princ end)(princ start)
; (plprops ent '("AREA" "LAY" "END" "START"))(princ area)(princ lay)(princ end)(princ start)
; (plprops ent '("START" "AREA" "LAY" "CW"))(princ start)(princ area)(princ cw)
; (plprops ent '("start" "END" "CORDS" "cw"))(princ start)(princ end)(princ coordsxy)(princ cw)
; (plprops ent '("CW"))(princ cw)
; (plprops ent '("AREA"))(princ area)
; (plprops ent '("CORDS"))(princ coordsxy)
; (lineprops ent "len"))(princ len)
; (lineprops ent '("len" "lay"))(princ len)(princ lay)
; (lineprops ent '("lay" "end" "start" "len"))(princ len)(princ lay)(princ start)(princ end)
; (circprops ent '("lay" "rad" "area" "cen"))(princ lay)(princ rad)(princ area)(princ cen)
; (circprops ent '("lay" "rad"))
; (arcprops ent '("lay" "rad"))

; PAS-Points at Snap
(defun c:PAS (/ ans selectedKeys)
  (if (not AH:Toggs)
    (load "Multiple toggles.lsp")
  )
  (setq ans (reverse (AH:Toggs '("Choose Snaps" "End" "Mid" "Center" "Quad"))))
  (if ans
    (progn
      (setq selectedKeys (reverse ans))
      (princ "\nSelected keys:")
      (foreach key selectedKeys
        (princ (strcat "\n" key))
      )
      (cords selectedKeys)
      (AH:chkcwccw selectedKeys)
      (plprops selectedKeys)
      (lineprops selectedKeys)
      (circprops selectedKeys)
      (arcprops selectedKeys)
    )
    (princ "\nNo keys selected.")
  )

  (princ)
)
 

I have tried calling the functions, getting the data from Toggle function and matching and seeing in the both and also i am missing to add the code for the points generation LISP code.
I am not sure where i am missing out.
Please help me out where i am doing wrong.

PAS.lsp

[BIGAL]

Sorry I should have read the question much closer this will give you a start, the intersection can only be done on its own as it involves 2 or more objects. The code needs more error checking, I went down the wrong path in the garden. Note the load Multi toggles no need for code to live in your code, just make sure you have Multi toggles.lsp in a support path or add your directory (load "C:\\mylisp\\Multi toogles.lsp")

 

The quad question needs 4 points left that for you fairly simple, I would call a defun as it will have to many lines to add to a cond. Use center and polar to work out the 4 points, hint, 0.0. (/ pi 2), pi, (* 1.5 pi) is the 4 angles.

 

; PAS-Points at Snap
(defun c:PAS (/ ans snaps snaps2 ent oldsnap xval)
  (if (not AH:Toggs)
    (load "Multiple toggles.lsp")
  )
  (setq oldsnap (getvar 'osmode))
  (setq snaps '("Choose Snaps" "Startpoint" "Endpoint" "Midpoint" "Center" "Intersection" ))
  (setq ans (reverse (AH:Toggs snaps)))
  (setq x 1 snaps2 '())
  (if (= (getvar 'pdmode) 0) (setvar 'pdmode 34))
  
  (foreach val ans
    (if (= val "1")(setq snaps2 (cons (nth x snaps) snaps2)))
    (setq x (1+ x))
  )
  (setq snaps2 (reverse snaps2))
  
  (if (= (nth 7 snaps) "1")
  (progn 
    (setvar 'osmode 32)
    (setq pt (getpoint "\nPick intersection point "))
    (command "Point" pt)
  )
  )
  
(setq ent (vlax-ename->vla-object (car (entsel "Pick Object "))))

(foreach val snaps2
  (cond 
    ((= val "Endpoint")(command "point" (vlax-curve-getEndPoint ent)))
    ((= val "Startpoint")(command "point" (vlax-curve-getstartPoint ent)))
    ((= val "Center")(command "point" (vlax-get ent 'Center)))
    ((and (= val "Midpoint") (= (vla-get-objectname ent) "AcDbLine"))(command "point" (mapcar '* (mapcar '+ (vlax-curve-getEndPoint ent)(vlax-curve-getstartPoint ent)) '(0.5 0.5))))
    ((and (= val "Midpoint") (= (vla-get-objectname ent) "AcDbPolyline"))(command "point" (vlax-curve-getpointatdist ent (/ (vlax-get ent 'length) 2.0))))
  )
)

 

Just remember the (nth 7 snaps) is the 7th item in the snaps list "Intersection". The (nth 0  is "Please choose".

 

I don't want to complicate but you can save the last results for next time in this Cad session.

 

Edited June 9, 2023 by BIGAL

[Pranesh Rathinam]

Hey Bigal,
I have found some the above code was not working for the selection set so i have tried by myself as it was basic i have found it out 2 line medication results in the selection set possibility.
Thanks for making me learn Bigal.

Now back to the LISP code,

1. I can see that now the below code can work wonderfully for Startpoint, Endpoint & Midpoint together.But if the case is to select Startpoint, Endpoint, Midpoint & Center together then i have the problem the LISP stops when it consider the point generation of the circle center.

 

(defun c:PAS (/ ans snaps snaps2 ent oldsnap xval)
  (if (not AH:Toggs)
    (load "Multiple toggles.lsp")
  )
  (setq oldsnap (getvar 'osmode))
  (setq snaps '("Choose Snaps" "Startpoint" "Endpoint" "Midpoint" "Center" "Intersection" ))
  (setq ans (reverse (AH:Toggs snaps)))
  (setq x 1 snaps2 '())
  (if (= (getvar 'pdmode) 0) (setvar 'pdmode 34))

  (foreach val ans
    (if (= val "1")(setq snaps2 (cons (nth x snaps) snaps2)))
    (setq x (1+ x))
  )
  (setq snaps2 (reverse snaps2))

  (if (= (nth 7 snaps) "1")
    (progn
      (setvar 'osmode 32)
      (setq pt (getpoint "\nPick intersection point "))
      (command "Point" pt)
    )
  )

  (setq ss (ssget))
  (setq i 0)
  (repeat (sslength ss)
    (setq ent (vlax-ename->vla-object (ssname ss i)))
    (foreach val snaps2
      (cond 
        ((= val "Endpoint")(command "point" (vlax-curve-getEndPoint ent)))
        ((= val "Startpoint")(command "point" (vlax-curve-getstartPoint ent)))
        ((= val "Center")(command "point" (vlax-get ent 'Center)))
        ((and (= val "Midpoint") (= (vla-get-objectname ent) "AcDbLine"))(command "point" (mapcar '* (mapcar '+ (vlax-curve-getEndPoint ent)(vlax-curve-getstartPoint ent)) '(0.5 0.5))))
        ((and (= val "Midpoint") (= (vla-get-objectname ent) "AcDbPolyline"))(command "point" (vlax-curve-getpointatdist ent (/ (vlax-get ent 'length) 2.0))))
      )
    )
    (setq i (1+ i))
  )
)

 

[Pranesh Rathinam]

Hey Bigal,
"Please Ignore my last post due to some tecnical fault i posted and also i was not able to edit it. Sorry for that"
I have found some of the above code lines was not working for the selection set so i have tried by myself as it was basic i have found it out 2 line modification results in the selection set incorporation possibility to your LISP Code.
Thanks for making me learn Bigal.


Now back to the LISP code,

• I can see that now the below code can work wonderfully for Startpoint, Endpoint & Midpoint toggle key combination. But if the case for the combination of Startpoint, Endpoint, Midpoint & Center then i faced the problem that the LISP code stops when it consider the node(point) creation at the circle center and further LISP code stops.

(defun c:PAS (/ ans snaps snaps2 ent oldsnap xval)
  (if (not AH:Toggs)
    (load "Multiple toggles.lsp")
  )
  (setq oldsnap (getvar 'osmode))
  (setq snaps '("Choose Snaps" "Startpoint" "Endpoint" "Midpoint" "Center" "Intersection" ))
  (setq ans (reverse (AH:Toggs snaps)))
  (setq x 1 snaps2 '())
  (if (= (getvar 'pdmode) 0) (setvar 'pdmode 34))

  (foreach val ans
    (if (= val "1")(setq snaps2 (cons (nth x snaps) snaps2)))
    (setq x (1+ x))
  )
  (setq snaps2 (reverse snaps2))

  (if (= (nth 7 snaps) "1")
    (progn
      (setvar 'osmode 32)
      (setq pt (getpoint "\nPick intersection point "))
      (command "Point" pt)
    )
  )

  (setq ss (ssget))
  (setq i 0)
  (repeat (sslength ss)
    (setq ent (vlax-ename->vla-object (ssname ss i)))
    (foreach val snaps2
      (cond 
        ((= val "Endpoint")(command "point" (vlax-curve-getEndPoint ent)))
        ((= val "Startpoint")(command "point" (vlax-curve-getstartPoint ent)))
        ((= val "Center")(command "point" (vlax-get ent 'Center)))
        ((and (= val "Midpoint") (= (vla-get-objectname ent) "AcDbLine"))(command "point" (mapcar '* (mapcar '+ (vlax-curve-getEndPoint ent)(vlax-curve-getstartPoint ent)) '(0.5 0.5))))
        ((and (= val "Midpoint") (= (vla-get-objectname ent) "AcDbPolyline"))(command "point" (vlax-curve-getpointatdist ent (/ (vlax-get ent 'length) 2.0))))
      )
    )
    (setq i (1+ i))
  )
)

  

• As you can see in the above code the intersection toggle key won't do any action as it was not defined. I tried modifying the above code with the help of below code which i had earlier posted to the same forum. (Actually i tried merging the LISP code but I ended up in a kind of major errors as i am newbie to LISP coding it happens....)

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
    (repeat (setq id1 (sslength sel))
        (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
        (repeat (setq id2 id1)
            (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
                  rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
            )
        )
    )
    (apply 'append (reverse rtn))
)
;; PAI-Point At Intersection
(defun c:PAI ( / sel )
    (if (setq sel (ssget))
        (foreach pnt (LM:intersectionsinset sel)
            (entmake (list '(0 . "POINT") (cons 10 pnt)))
        )
    )
    (princ)
)
(vl-load-com) (princ)

 

1. Please help me out to fix these above bulleted issues.
2. Also at last please help me out in the combination issues (Startpoint, Endpoint, Midpoint, Center & Intersection) so that the all the toggle keys are on then also it detects for the selection set objects properties and creates the points for the applicable areas of the so the non-applicable areas remains ignored. (I don't want this LISP to gets existed half way while running)

 

Please help/Guide me to achieve these requirements.
Thanks for your knowledge and support.
Happy Weekend,
Warm Regards,
Pranesh Rathinam.

Edited June 9, 2023 by Pranesh Rathinam

[BIGAL]

Ok I dId have it at one stage you can check does object have a property so if you pick center and its a line then it does not have that property. Need to add a If to the cond before the setq.

 

(vlax-property-available-p itm 'isxref) so this returns true if a xref.

 

(if (vlax-property-available-p ent 'center) (command "point" (vlax-get ent 'Center)))

 

[CANDOWE]

bigal is really a hotwarming nice handsome guy.