Jump to content

Lisp to Align Mtext to nearest polyline end


asdfgh

Recommended Posts

(defun c:test (/ int sel ent get pos pts ins srt)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect Polylines & Texts : ")
       (setq int -1
             sel (ssget "_:L" '((0 . "*TEXT,LWPOLYLINE")))
       )
       (while (setq int (1+ int)
                    ent (ssname sel int)
              )
         (setq get (entget ent)
               pos (cdr (assoc 10 get))
         )
         (or (and (= (cdr (assoc 0 get)) "LWPOLYLINE")
                  (setq pts (cons pos pts)
                        pts (cons (cdr (assoc 10 (reverse get))) pts)
                  )
             )
             (setq ins (cons (list pos ent) ins))
         )
       )
       (while (and ins pts)
         (and (setq pos (car ins))
              (setq srt (car (vl-sort
                               pts
                               (function
                                 (lambda (j k)
                                   (< (distance (car pos) j) (distance (car pos) k))
                                 )
                               )
                             )
                        )
                    pts (vl-remove srt pts)
              )
              (vlax-invoke
                (vlax-ename->vla-object (cadr pos))
                'Move
                (car pos)
                (append srt '(0.0))
              )
         )
         (setq ins (cdr ins))
       )
  )
  (princ)
) (vl-load-com)

 

  • Like 1
Link to comment
Share on other sites

  • 1 year later...
On 9/6/2022 at 6:46 PM, Tharwat said:
(defun c:test (/ int sel ent get pos pts ins srt)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (princ "\nSelect Polylines & Texts : ")
       (setq int -1
             sel (ssget "_:L" '((0 . "*TEXT,LWPOLYLINE")))
       )
       (while (setq int (1+ int)
                    ent (ssname sel int)
              )
         (setq get (entget ent)
               pos (cdr (assoc 10 get))
         )
         (or (and (= (cdr (assoc 0 get)) "LWPOLYLINE")
                  (setq pts (cons pos pts)
                        pts (cons (cdr (assoc 10 (reverse get))) pts)
                  )
             )
             (setq ins (cons (list pos ent) ins))
         )
       )
       (while (and ins pts)
         (and (setq pos (car ins))
              (setq srt (car (vl-sort
                               pts
                               (function
                                 (lambda (j k)
                                   (< (distance (car pos) j) (distance (car pos) k))
                                 )
                               )
                             )
                        )
                    pts (vl-remove srt pts)
              )
              (vlax-invoke
                (vlax-ename->vla-object (cadr pos))
                'Move
                (car pos)
                (append srt '(0.0))
              )
         )
         (setq ins (cdr ins))
       )
  )
  (princ)
) (vl-load-com)

 

 

 

Please , How to Select All Polylines in the drawing except from Frozen and Locked and OFF layers ?

 

 

Edited by Engineer_Yasser
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.

×
×
  • Create New...