Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/23/2022 in all areas

  1. Draw a horizontal XLine, see where it intersects with the polylines, now look for the closest X-value of those intersect points with the polylines. Delete the temporary XLINE. (vl-load-com) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ ;; draw a XLINE (defun drawxLine (pt vec) (entmakex (list (cons 0 "XLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbXline") (cons 10 pt) (cons 11 vec)))) ;; draw MText (defun drawM-Text (pt str) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 1 str)))) (defun drawLine (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Intersections - Lee Mac ;; http://www.lee-mac.com/intersectionfunctions.html ;; Returns a list of all points of intersection between two objects ;; for the given intersection mode. ;; ob1,ob2 - [vla] VLA-Objects ;; mod - [int] acextendoption enum of intersectwith method ;; acextendnone Do not extend either object ;; acextendthisentity Extend obj1 to meet obj2 ;; acextendotherentity Extend obj2 to meet obj1 ;; acextendboth Extend both objects (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst) ) ) ) (reverse rtn) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:npp ( / txt plines xline pt obj2 ins insx insx_sorted xl xr str) (princ "\nSelect ploylines") (setq plines (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE")))) (setq txt (entsel "\nSelect Text object: ")) (setq str (cdr (assoc 1 (entget (car txt))))) (setq pt (cdr (assoc 10 (entget (car txt))))) ;; draw a horizontal XLINE (setq xline (drawxLine pt (list 1.0 0.0))) ;; (list 1.0 0.0) draws to the right, (list 0.0 1.0) draws up thus vertical, ... ;; now look for intersect points of the XLINE with the polylines (setq insx (list)) ;; list of intersect points. Only the X value. (setq i 0) (repeat (sslength plines) (setq obj2 (ssname plines i)) (setq ins (LM:intersections (vlax-ename->vla-object xline) (vlax-ename->vla-object obj2) acextendnone)) ;; if there are intersect points, add the x-value to the list (foreach a ins (setq insx (append insx (list (nth 0 a) ))) ) (setq i (+ i 1)) ) ;; we no longer need the XLINE, we delete it (entdel xline) ;; sort the insx values from left to right (setq insx_sorted (vl-sort insx '<)) ;;(princ insx_sorted) ;; now we go looking for xl (left of the text) and xr (right of the text) (setq xl nil) (setq xr nil) (foreach a insx_sorted (if (< a (nth 0 pt)) ;; as long as the insert point is to the left, we'll replace xl (setq xl a) ) (if (and (not xr) (> a (nth 0 pt))) ;; the first insert point the right is the closest one (setq xr a) ) ) ;;(princ "\nLeft: ") ;;(princ xl) ;;(princ " - Right: ") ;;(princ xr) ;;(princ ) ;; draw line ;; we add the Y value of the Text object to get a point (drawLine (list xl (nth 1 pt)) (list xr (nth 1 pt))) ;; draw Mtexts (drawM-Text (list xl (nth 1 pt)) (strcat str " l1")) (drawM-Text (list xr (nth 1 pt)) (strcat str " r1")) )
    2 points
  2. @BIGAL No need to convert to an object when using curve functions. Plus you need to check if the object is actually selected and valid before trying to do anything with it. And what are you doing with the length ?
    1 point
  3. For mhupp no need for R or L pick use the pick end to imply side, check pick pt to start, end point, and this implies line direction so know L or R. (setq ent (entsel "\npick object ")) (setq pt (cadr ent)) (setq obj (vlax-ename->vla-object (car ent))) (setq end (vlax-curve-getendpoint Obj)) (setq start (vlax-curve-getstartpoint Obj)) (setq len (vla-get-length obj)) (setq d1 (distance pt end)) (setq d2 (distance pt start)) (if (< d1 d2) (progn (setq temp end) (setq end start) (setq start temp) (reverse ent) ) )
    1 point
  4. It is always a pity when negative feedback is posted about something that was given freely. The phrase 'looking a gift horse in the mouth' springs to mind. Did you read the working parameters at the beginning of the lisp file? Just open the file in a text reader, and you will see that the outcome is not a hatch. So how can you think that the scale can be altered? Perhaps you are voicing your discontent that the lisp does not do what you think it ought to do!
    1 point
×
×
  • Create New...