Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/20/2020 in all areas

  1. (defun c:pso ( / cl1 cl2 d pt pt2 templine ang spc ) ;;; pBe 30Aug2014 ;;; (if (and (princ "\nSelect the main alignment") (setq cl1 (ssget "_:S" '((0 . "*POLYLINE")))) (princ "\nSelect the offset alignment") (setq cl2 (ssget "_:S" '((0 . "*POLYLINE")))) ) (progn [color="blue"] (setq d (cond ((getdist (strcat "\nEnter increment value: " " <" (rtos (setq d (cond ( d_ ) ( 100.00 )) ) 2 2) ">: "))) ( d ) ) )[/color] (setq cl1 (ssname cl1 0) cl2 (ssname cl2 0) d_ d) (while (setq pt (vlax-curve-getpointatdist cl1 d)) (setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv cl1 (vlax-curve-getparamatpoint cl1 pt) ) ) ) (setq templine (vlax-invoke (setq spc (vlax-get (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object ))) 'Block)) '[color="blue"]AddXline[/color] pt (polar pt (setq ang (+ ang (* pi 1.5))) 1)) ) (if (setq pt2 (vlax-invoke templine 'IntersectWith (vlax-ename->vla-object cl2) 0 ) ) [color="red"] (vlax-invoke spc 'Addline pt (list (Car pt2)(cadr pt2)(caddr pt2)))[/color] ) (vla-delete templine) (setq d (+ d d_)) ) ) ) (princ) ) (vl-load-com) command: pso
    1 point
  2. There are a couple of ways to do this and only have 1 set of code, this is just one suggestion. It relies on you typing the function name with the values on the command line (txt2 2 300) (txt2 2 "A") note strings must have quotes. If you want to type 230 on the command line you can do that by making lots of mini defuns (defun c:230 ()(txt2 2 300)) have to repeat for all combo's you want. The 3rd option more complicated is you can type tx-y where x & y are any numbers, alpha's and a reactor method is used to provide the values to say (txt2 x y) need some time to recode some existing code which uses a error trapping method. ; original code by Tharwat ; two text entries added by AlanH (defun txt2 (t1 t2 / inc lst str brk sel get) (cond ((= (type t1) 'INT )(setq t1 (rtos t1 2 0))) ((= (type t1) 'REAL)(setq t1 (rtos t1 2 2))) ) (cond ((= (type t2) 'INT )(setq t2 (rtos t2 2 0))) ((= (type t2) 'REAL)(setq t2 (rtos t2 2 2))) ) (setq inc 0 lst (list t1 t2) str '("1st" "2nd") ) (while (and (not brk) (princ (strcat "\nSelect " (nth inc str) " text to replace with < " (nth inc lst) " > : ." ) ) ) (and (setq sel (ssget "_+.:S:E:L" '((0 . "*TEXT")))) (entmod (subst (cons 1 (nth inc lst)) (assoc 1 (setq get (entget (ssname sel 0)))) get ) ) (setq inc (1+ inc)) (= inc 2) (setq brk t) ) ) (princ) )
    -1 points
×
×
  • Create New...