Leaderboard

I often use this helper function below to make it easier to go over a selection set: ;| ; Foreach-ss by dexus ; Loop over every item in a selectionset ; @Param input selection set ; @Param inputfunc function to execute over every item |; (defun foreach-ss (input inputfunc / n) (if (= 'PICKSET (type input)) (repeat (setq n (sslength input)) (inputfunc (ssname input (setq n (1- n)))) ) ) ) Can be used like this: (foreach-ss (ssget) (lambda (e) (princ (cdr (assoc 0 (entget e)))) ) )

Try this: (defun LSTrimToPt ( MyLine TrimPt1 TrimPt2 / MyLineDef MyLineEndA MyLineEndB Pt1Dist Pt2Dist TempPt MyLineA MyLineB currentzoom) (defun breakatpoint (MyEnt point /) (command "_.break" MyEnt "_non" point "_non" point) ) (defun LSZmObj (ss / Minp Maxp lst) ; zooms to an object +area around the end points (foreach Obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (vla-getBoundingBox Obj 'Minp 'Maxp) (setq lst (cons (mapcar 'vlax-safearray->list (list Minp Maxp)) lst))) (vla-ZoomWindow (vlax-get-acad-object) (vlax-3D-point (list (apply 'min (mapcar 'car (mapcar 'car lst))) (apply 'min (mapcar 'cadr (mapcar 'car lst))) 0.0)) (vlax-3D-point (list (apply 'max (mapcar 'car (mapcar 'cadr lst)))(apply 'max (mapcar 'cadr (mapcar 'cadr lst))) 0.0)) ) ) (setq currentzoom (list (getvar 'viewctr) (getvar 'viewsize))) ;; record the current zoom (LSZmObj (ssadd MyLine)) ;; Zoom to show the full line (vla-ZoomScaled (vlax-get-acad-object) 0.95 acZoomScaledRelative) ;; Zoom out a bit (setq MyLineDef (entget MyLine)) ;; Get polyline entity definition (setq MyLineEndA (cdr (assoc 10 MyLineDef))) ;; Get the points of the line (if (= (cdr (assoc 0 MyLineDef)) "LINE") ;; Get end points of line / polyline (setq MyLineEndB (cdr (assoc 11 MyLineDef))) (setq MyLineEndB (cdr (assoc 10 (reverse MyLineDef)))) ) ;;sort trimpts according to distance from end A (setq Pt1Dist (vlax-curve-getdistatpoint (vlax-ename->vla-object MyLine) TrimPt1) ) (setq Pt2Dist (vlax-curve-getdistatpoint (vlax-ename->vla-object MyLine) TrimPt2) ) (if ( > Pt1Dist Pt2Dist) ; swap trim points over (progn (setq TempPt TrimPt1) (setq TrimPt1 TrimPt2) (setq TrimPt2 TempPt) ) ;end progn () ) ;end if (breakatpoint MyLine TrimPt1) ;;"Too many objects for INTERSECT" (setq MyLineA (entlast)) (if (equal MyLineA MyLine 0.0001) (progn ; if end A is trim point (breakatpoint MyLine TrimPt2) ;;"Too many objects for INTERSECT" (setq MyLineB (entlast)) (if (equal MyLineB MyLine 0.0001) ; if end B is trim point () (entdel MyLineB) ) ) (progn (entdel MyLine) (breakatpoint MyLineA TrimPt2) ;;"Too many objects for INTERSECT" (setq MyLineB (entlast)) (if (equal MyLineB MyLineA 0.0001) ; if end B is trim point (progn ) (progn (entdel MyLineB) ) ) ) ) ; end if (vla-ZoomCenter (vlax-get-acad-object) (vlax-3d-point (car currentzoom)) (cadr currentzoom)) MyLineA ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:test ( / Route TrimmedRoute PtA PtB) (setq Route (car (entsel "Select Line / PolyLine"))) (setq PtA (getpoint "Select trim point 1")) (setq PtB (getpoint "Select trim point 2")) (setq TrimmedRoute (entmakex (entget Route))) ; Copy route (setq TrimmedRoute (LSTrimToPt TrimmedRoute PtA PtB)) )

I was thinking... This code from @Steven P is also good... I just took some spare time to mod. it to suit my needs... Carefully read (alert) comment and you are ready to go testing it... All the best to author and others reading post... (defun c:PlPath-single ( / *error* LSTrimToPt cmd osm ss Route rx uf TrimmedRoute PtA PtB ) (or (not (vl-catch-all-error-p (vl-catch-all-apply (function vlax-get-acad-object) nil))) (vl-load-com)) (defun *error* ( m ) (if uf (if command-s (command-s "_.ucs" "_p") (vl-cmdf "_.ucs" "_p") ) ) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if command-s (command-s "_.undo" "_e") (vl-cmdf "_.undo" "_e") ) ) (if osm (setvar (quote osmode) osm) ) (if cmd (setvar (quote cmdecho) cmd) ) (if m (prompt m) ) (princ) ) (defun LSTrimToPt ( MyLine TrimPt1 TrimPt2 / Pt1Dist Pt2Dist TempPt MyLineA MyLineB ) (defun breakatpoint ( MyEnt point ) (command "_.break" MyEnt "_non" point "_non" point) ) (if command-s (command-s "_.zoom" "_ob" MyLine "") (vl-cmdf "_.zoom" "_ob" MyLine "") ) (vla-ZoomScaled (vlax-get-acad-object) 0.95 acZoomScaledRelative) ;; Zoom out a bit ;;sort trimpts according to distance from end A (setq Pt1Dist (vlax-curve-getdistatpoint MyLine TrimPt1)) (setq Pt2Dist (vlax-curve-getdistatpoint MyLine TrimPt2)) (if (> Pt1Dist Pt2Dist) ; swap trim points over (progn (setq TempPt TrimPt1) (setq TrimPt1 TrimPt2) (setq TrimPt2 TempPt) ) ;end progn ) ;end if (breakatpoint MyLine (trans TrimPt1 0 1)) (setq MyLineA (entlast)) (if (equal MyLineA MyLine 0.0001) (progn ; if end A is trim point (breakatpoint MyLine (trans TrimPt2 0 1)) (setq MyLineB (entlast)) (if (not (equal MyLineB MyLine 0.0001)) ; if end B is trim point (entdel MyLineB) ) ) (progn (entdel MyLine) (breakatpoint MyLineA (trans TrimPt2 0 1)) (setq MyLineB (entlast)) (if (not (equal MyLineB MyLineA 0.0001)) ; if end B is trim point (entdel MyLineB) ) ) ) ; end if MyLineA ) (alert "If you want trimming on opposite side, you should change initial vertex of LWPOLYLINE (if your reference object is LWPOLYLINE) - use (c:chiv) if you have it loaded...") (setq cmd (getvar (quote cmdecho))) (setvar (quote cmdecho) 0) (setq osm (getvar (quote osmode))) (setvar (quote osmode) 545) (if (= 8 (logand 8 (getvar (quote undoctl)))) (if command-s (command-s "_.undo" "_e") (vl-cmdf "_.undo" "_e") ) ) (if command-s (command-s "_.undo" "_m") (vl-cmdf "_.undo" "_m") ) (prompt "Select Line / PolyLine / Spline / HELIX on unlocked layer...") (if (setq ss (ssget "_+.:E:S:L" (list (cons 0 "*POLYLINE,SPLINE,HELIX,LINE")))) (progn (setq Route (ssname ss 0)) (if (or (if (assoc 210 (setq rx (entget Route))) (not (equal (cdr (assoc 210 rx)) (list 0.0 0.0 1.0) 1e-6)) ) (if (assoc 38 rx) (not (zerop (cdr (assoc 38 rx)))) ) ) (progn (if command-s (command-s "_.ucs" "_ob" Route) (vl-cmdf "_.ucs" "_ob" Route) ) (setq uf t) ) (if (= 0 (getvar (quote worlducs))) (progn (if command-s (command-s "_.ucs" "_w") (vl-cmdf "_.ucs" "_w") ) (setq uf t) ) ) ) (setq PtA (getpoint "Select Start point : ")) (setq PtB (getpoint PtA "Select End point : ")) (if (= 0 (getvar (quote worlducs))) (progn (setq PtA (trans PtA 1 0)) (setq PtB (trans PtB 1 0)) ) ) (setq TrimmedRoute (entmakex rx)) ; Copy route (setq TrimmedRoute (LSTrimToPt TrimmedRoute PtA PtB)) (repeat 2 (if command-s (command-s "_.zoom" "_p") (vl-cmdf "_.zoom" "_p") ) ) (if command-s (command-s "_.draworder" (ssadd TrimmedRoute) "" "_f") (vl-cmdf "_.draworder" (ssadd TrimmedRoute) "" "_f") ) ) ) (*error* nil) ) HTH. Regards, M.R.

You can create a text object with one command. If you want a multiline text, you have to do some work, but you get more control. Look into the DXF codes. You can create a multitext with the entmake command using a list of these codes in this order: Entity Type - (0 . "MTEXT") Object Type - (100 . "AcDbEntity") Layer - (8 . <layer name>) Object Subtype - (100 . "AcDbMText") Location - (10 . <point>) Direction of UCS - (11 . (getvar 'ucsxdir)) Translation Matrix - (210 . '(0 0 1) 1 0 T) Text Height - (40 . <height>) Justification - (71 . <insertion point, see below>) Contents - (1 . <text>) Style - (7 . <style>) Rotation - (50 . <angle in radians>) Fill - (90 . <code, see below>) Background Color (pick one) - (63 . <color index>) / (420-429 . <RGB color>) / (430 . <color name>) Fill Box Scale (optional) - (45 . <margin>) Transparency - (441 . 0) Some notes: The Justification value is an integer: 1=top left, 2=top center, 3=top right, 4=middle left, etc. You can omit the Style code, it will default to Standard. The Fill code is the sum of these integers: 0=none, 1=background, 2=drawing window color. For the multileader options, here's another set of codes. I haven't had time to figure out exactly how these work. I know, it's a lot of information. If you have questions, post a response.

I thought i did an edit on the code yes should be I just me I use X all the time.

"i" is correct

It looks like the code is okay and the magenta polyline is showing up in some places. Could the issue be drawing order? That is, the magenta polyline gets drawn first and then other items get drawn over it. It's there, you just can't see it.

Here's another - (defun c:brace ( / ang blg di1 di2 mat rad pt1 pt2 ) (setq rad 1.0) ;; Brace radius (if (and (setq pt1 (getpoint "\nSpecify 1st point for brace: ")) (progn (while (and (setq pt2 (getpoint "\nSpecify 2nd point for brace: " pt1)) (< (distance pt1 pt2) (* 4 rad)) ) (princ "\nDistance between the two points must be greater than 4 times the radius.") ) pt2 ) ) (progn (setq di1 (distance pt1 pt2) di2 (- (/ di1 2.0) rad) ang (angle pt1 pt2) mat (list (list (cos ang) (- (sin ang))) (list (sin ang) (cos ang))) blg (1- (sqrt 2.0)) ) (entmake (append '( (000 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (090 . 7) (070 . 0) ) (apply 'append (mapcar (function (lambda ( a b ) (list (cons 010 (mapcar '+ (mapcar '(lambda ( r ) (apply '+ (mapcar '* r a))) mat) pt1)) (cons 042 b) ) ) ) (list '(0.0 0.0) (list rad (- rad)) (list di2 (- rad)) (list (+ di2 rad) (- 0 rad rad)) (list (- di1 di2) (- rad)) (list (- di1 rad) (- rad)) (list di1 0.0) ) (list blg 0.0 (- blg) (- blg) 0.0 blg 0.0) ) ) (list (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))) ) ) ) ) (princ) ) To flip the brace, pick the points in the opposite direction.