Author Topic: draw line from 1 point to a list of points  (Read 257 times)

0 Members and 1 Guest are viewing this topic.

PM

  • Bull Frog
  • Posts: 215
draw line from 1 point to a list of points
« on: June 06, 2021, 11:48:30 AM »
Hi.I have this lisp code to draw lines between points. I want to update this code to draw lines from one point to a list of others.

for example
1)give the first point -->s1
2)give a list of mumbers --> 1- 4

or give a txt file with a list of points like the attach file

The solution with the txt file must be better

Code - Auto/Visual Lisp: [Select]
  1. (defun c:lineat (/ data AllPointnumber stop pts data i p pv pts_)
  2. (setq ped (getvar 'peditaccept))
  3. (setvar 'peditaccept 1)
  4. (if (setq AllPointnumber nil stop nil pts nil
  5.            data (ssget "_X" (list '(0 . "INSERT")'(66 . 1)'(2 . "Point,KORYFES,station,trigonom,KOKAEK,KOROT,AnnotPoint,AnnotKORYFES,Annotstation,Annottrigonom,AnnotKOKAEK,AnnotKOROT")(cons 410 (getvar 'Ctab)))))
  6.         (progn
  7.           (repeat (setq i (sslength data))
  8.             (if (setq
  9.                   p (vl-some '(lambda (x)
  10.                                 (if (eq (vla-get-tagstring x) "POINT")
  11.                                   (list (vla-get-textstring x)
  12.                                         (vlax-get e 'Insertionpoint)
  13.                                   )
  14.                                 )
  15.                               )
  16.                              (vlax-invoke
  17.                                (setq e (vlax-ename->vla-object
  18.                                          (ssname data (setq i (1- i)))
  19.                                        )
  20.                                )
  21.                                'GetAttributes
  22.                              )
  23.                     )
  24.                 )
  25.               (setq AllPointnumber (cons p AllPointnumber))
  26.             )
  27.           )
  28.         (setq 2bjoin (ssadd))
  29.           (while (null Stop)
  30.                 (setq pv   (getstring "\nGive the Point number <Enter to exit>: "))
  31.                 (cond
  32.                       ((setq a (assoc (strcase pv) AllPointnumber))
  33.                        (setq pts (cons (cadr a) pts) pts_ (cons (cadr a) pts_))
  34.                        (if (= (length pts) 2)
  35.                            (progn
  36.                                 (entmakex (list (cons 0 "LINE")
  37.                                 (cons 10 (car pts))
  38.                                 (cons 11 (cadr pts))))
  39.                                 (setq  pts (list (car pts)))(ssadd (entlast) 2bjoin)
  40.                                 )
  41.                            )
  42.                        )
  43.                       ((eq pv "") (setq stop "Done"))
  44.                       ((eq (strcase pv) "U")
  45.                        (entdel (setq del (ssname 2bjoin (1- (sslength 2bjoin)))))(ssdel  del 2bjoin)
  46.                        (setq pts_ (cdr pts_) pts  (list (car pts_)) ))
  47.                       ((null a) (princ "\n<<Point value not found>>"))  
  48.                       ))
  49.           (initget "Yes No")
  50.           (setq convert (cond ( (getkword "\nConvert to polylines? [Yes/No] <N>: ") ) ( "No" )))
  51.           (if (eq "Yes" convert)
  52.               (command "_.pedit" "_M" 2bjoin  "" "_J" "" ""))
  53.           )
  54.     )
  55.     (setvar 'peditaccept ped)
  56.       (princ)
  57.       )
  58.  
  59.  


Thanks

PM

  • Bull Frog
  • Posts: 215
Re: draw line from 1 point to a list of points
« Reply #1 on: June 06, 2021, 02:57:15 PM »
Any options?

Thanks

PM

  • Bull Frog
  • Posts: 215
Re: draw line from 1 point to a list of points
« Reply #2 on: June 06, 2021, 06:06:39 PM »
i FIX IT

Code - Auto/Visual Lisp: [Select]
  1. (defun c:Test (/ sel obj lst pts bas)
  2.  (princ "\nSelect point objects :")
  3.  (if (setq sel (ssget "_:L" '((0 . "INSERT"))))
  4.    (while (setq obj (ssname sel 0))
  5.      (setq lst (cons (cdr (assoc 10 (entget obj))) lst)
  6.            pts (cons obj pts))
  7.      (ssdel obj sel)
  8.      )
  9.    )
  10.  (and lst
  11.       (setq bas (getpoint "\nSpecify base Point :"))
  12.       (foreach p lst
  13.         (entmake (list '(0 . "LINE") (cons 10 bas) (cons 11 p)))
  14.       )
  15.  )
  16.  (princ)
  17. )
  18.  
  19.