Leaderboard

To help understand the behavior of vlax-curve-getPointAtParam, here is a procedure to dynamically display the Param value at the cursor point when the cursor hovers or tries to track over the objects mentioned by@devitg (defun c:dyn_read_param ( / AcDoc Space nw_obj ent_text dxf_ent ncol strcatlst Input obj_sel ename) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 "" ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (/ (getvar "VIEWSIZE") 50.0) 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 250) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent) ncol 0 ) (entmod dxf_ent) (while (and (setq Input (grread T 4 2)) (= (car Input) 5)) (cond ((setq obj_sel (nentselp (cadr Input))) (setq ename (vlax-ename->vla-object (car obj_sel))) (if (not (zerop (apply 'logior (mapcar '(lambda (x) (if (vlax-property-available-p ename x) 1 0) ) '("Length" "ArcLength" "Circumference" "Perimeter" "Area") ) ) ) ) (setq strcatlst (strcat (if strcatlst strcatlst "") "Object Type: " (vlax-get-property ename 'ObjectName) "\nStart Param: " (rtos (vlax-curve-getStartParam ename) 2 4) "\nParam At Point: " (rtos (vlax-curve-getParamAtPoint ename (vlax-curve-getClosestPointTo ename (cadr Input))) 2 4) "\nEnd Param: " (rtos (vlax-curve-getEndParam ename) 2 4) ) ) ) (if strcatlst (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'InsertionPoint 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'TextString) (list (polar (trans (cadr Input) 1 0) (* 1.75 pi) (/ (getvar "VIEWSIZE") 50.0)) 1 (/ (getvar "VIEWSIZE") 50.0) 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 (strcat "{\\fArial;" strcatlst "}" )) ;"TechnicBold" ) ) (setq strcatlst nil) ) ) ) (vla-Delete nw_obj) (prin1) )

That's a fun one to write. This should work. Command IBTV, for Insert Block To Vertex (feel free to change the function name) ;; 1. lisp prompt the user to select a ployline. ;; 2. lisp prompt the user to enter the vertex number. ;; 3. lisp inserting a block at the selected vertex. (defun drawInsert (pt Nme) (entmakex (list (cons 0 "INSERT") (cons 2 Nme) (cons 10 pt)))) ;; LW Vertices - Lee Mac ;; Returns a list of lists in which each sublist describes ;; the position, starting width, ending width and bulge of the ;; vertex of a supplied LWPolyline (defun LM:LWVertices ( e ) (if (setq e (member (assoc 10 e) e)) (cons (list (assoc 10 e) (assoc 40 e) (assoc 41 e) (assoc 42 e) ) (LM:LWVertices (cdr e)) ) ) ) ;; Command IBTV, for Insert Block To Vertex (feel free to change the function name) (defun c:ibtv ( / Nme pl vertices ind str_ pt) (setq Nme "3014") ;; 1. lisp prompt the user to select a ployline. (setq pl (ssname (ssget "_+.:S" (list (cons 0 "*POLYLINE"))) 0) ) ;; 2. lisp prompt the user to enter the vertex number. (setq vertices (LM:LWVertices (entget pl))) ;;(princ vertices) (princ (length vertices)) (setq str_ (strcat "\nEnter vertex number (1 to " (itoa (length vertices) ) "): " )) (if (and (setq ind (getint str_)) (> ind 0) (< ind (+ (length vertices) 1)) ) (progn ;; 3. lisp inserting a block at the selected vertex. (setq pt (cdr (assoc 10 (nth (- ind 1) vertices)))) (drawInsert pt Nme) ) ) (princ) )

You could always use a reactor to automatically switch to the correct layer when you use xline command: (vl-load-com) (if (not layer:reactor) (setq layer:reactor (vlr-command-reactor nil '((:vlr-commandWillstart . sCom) (:vlr-commandEnded . eCom) (:vlr-commandCancelled . cCom))))) (or (tblsearch "LAYER" "CONSTRUCTION") (vla-put-Color (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) "CONSTRUCTION") acRed)) (defun sCom (Reac Args) (setq oldlay (getvar 'CLAYER)) (if (eq "XLINE" (car Args)) (setvar 'CLAYER "CONSTRUCTION")) (princ)) (defun eCom (Reac Args) (if (eq "XLINE" (car Args)) (setvar 'CLAYER oldlay)) (princ)) (defun cCom (Reac Args) (if (eq "XLINE" (car Args)) (setvar 'CLAYER oldlay)) (princ)) Just put this in your ACADDOC.lsp or Start-up Suite HTH Lee

Noticed that the scaleaxis.lisp has been remove, so here it is a agian - no idea who the author is and it changes everything to lines but it is a simple way to scale everything in one direction. ;;;SCALEAXIS.LSP ;-------------------------------------------------- ; ERROR TRAPPING ;-------------------------------------------------- (defun errtrap (msg) (cond ((not msg)) ( (member msg '("Function cancelled" "quit / exit abort")) (command "undo" "") ) ( (princ (strcat "\nError: " msg)) (command "undo" "") ) );cond );defun ;-------------------------------------------------- ; MAIN ROUTINE ;-------------------------------------------------- (defun c:scaleaxis (/ *error* *ss1 bspt ax mult refpt refdx newdx) (command "._undo" "end" "._undo" "begin") (setq *error* errtrap) (setq ss1 (ssget)) (setq bspt (getpoint "\nSelect basepoint: ")) (initget "X Y Z") (if (not (setq ax (getkword "\nSpecify axis to scale: <X> ")) );not (setq ax "X") );if (if (not (setq mult (getreal "\nEnter scale factor or <Reference>: ")) );not (progn (setq refpt1 (getpoint "\nSpecify reference length: ")) (setq refdx (getdist refpt1 "\nSpecify second point: ")) (setq newdx (getdist refpt1 "\nSpecify new length: ")) (setq mult (/ newdx refdx)) );progn );if (setvar "expert" 2) (setvar "explmode" 1) (command "._-block" "SCALETEMP" bspt ss1 "") (command "._-insert" "SCALETEMP" ax mult bspt "0") (command "._explode" "last" "") (command "._-purge" "blocks" "SCALETEMP" "n") (setvar "expert" 1) (command "._undo" "end") (princ) (*error* nil) )