Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/21/2023 in all areas

  1. (defun c:mln ( / _OffsetTo items ofd InsertAt evenp layersAndColors plines base) (vl-load-com) (defun _OffsetTo (v e n flg / hfl v x y col v_) (setq hlf (if flg (* v 0.5) 0 ) i 1 v_ v) (repeat n (setq y (car (vlax-invoke e 'Offset (if (and flg (null col)) (setq x hlf) (progn (setq x (+ hlf v) v (+ v v_) i (1+ i) ) x ) ) ) ) ) (setq col (cons (list x y) col)) ) col ) (defun InsertAt (item ind lst);; Gile ;; (if (or (zerop ind) (null lst)) (cons item lst) (cons (car lst) (InsertAt item (1- ind) (cdr lst))) ) ) (if (and (setq plines nil layersAndColors nil items (getint "\nNumber of parallel lines: ")) (< 1 items 13);<-- limit to 12 (setq ofd (getdist "\nDistance between lines ")) ) (progn (repeat (Setq ln items) (setq layersAndColors (cons (list (Strcat "Layer" (itoa ln)) ln) layersAndColors) ln (1- ln))) (foreach lnm layersAndColors (if (not (tblsearch "Layer" (car lnm))) (command "_layer" "_new" (car lnm) "_color" (cadr lnm) (car lnm) ""))) (command "_Pline") (while (> (getvar "CMDACTIVE") 0)(command pause)) (setq base (vlax-ename->vla-object (entlast))) (setq evenp (zerop (rem items 2))) (foreach val (list ofd (- ofd)) (setq plines (cons (_OffsetTo val base (/ items 2) evenp) plines))) (setq plines (apply 'append (if evenp (progn (vla-delete base) plines) (InsertAt (list (list 0 base)) (/ (length plines) 2) plines ) ) ) ) (mapcar 'vla-put-layer (mapcar 'cadr (vl-sort plines '(lambda (j k)(< (Car j)(car k))))) (mapcar 'car layersAndColors)) );progn );if (princ) ) Lisp draws 2-12 polylines of different colors with a choice of the distance between them. I don't know the author... Calling with the mln command
    1 point
  2. What software did you use to screen cap? looks like its just a rounding error when your only inputting two digits for the length. Then you need to update the value of YV and add the next one to it to get the right value. 7.200+(-2.39969)=4.80031 4.80031+(-2.00037)=2.79994 if you want to keep the code the way it is see if this works for you. (defun C:LA (/ P1 P2 P3 P4 AL EL ANG XV YV) (setq P1 (getpoint "\n PICK FIRST POINT OF REF-LINE:") P2 (getpoint P1 "\n PICK SECOND POINT OF REF-LINE:") AL 0 YV 0 ;added code ) (command "UCS" "3" P1 P2 "") (while (setq P3 (getpoint "\n PICK FIRST POINT :") P4 (getpoint P3 "\n PICK SECOND POINT :") ) (setq EL (distance P3 P4) ;don't need to input just calc the distance from the two points. will also get rid of rounding errors. AL (+ AL EL) ANG (angle P3 P4) XV (* (cos ANG) AL) YV (+ YV (* (sin ANG) EL)) ;update value like your doing with AL ) (prompt (strcat "\n" (rtos XV 2))) (prompt (strcat "\n" (rtos YV 2))) ) ) Improved code only have to pick the two polylines and one point to get the values you want. Benefits: Selecting any point on the polyline with nearest not just endpoints midpoint. Can select points out of order or only points you want to check. ref line doesn't need to start at same point the measured line does. Only problem I see is if the polyline is started from the other side it will need to be reversed to give the correct Distance. and the refence line needs to be longer then the polyline being measured or it wont give the right Y value. Example. (defun C:LA_improved (/ ref line P1 P2) (setq ref (car (entsel "\n Pick Reference Line"))) (setq line (car (entsel "\n Pick Polyline to Measure"))) (while (setq P1 (getpoint "\n Pick Point on Line :")) (setq P2 (vlax-curve-getClosestPointTo ref P1)) (prompt (strcat "\nX: " (rtos (vlax-curve-getdistatpoint line P1) 2))) (prompt (strcat "\nY: " (rtos (distance P1 P2) 2))) ) ) props to vlax-curv functions
    1 point
  3. Manually trim select mline then pick point at midpoint of each side of red plines seems to work. So get all rectangs do a offset and get te co-ords of that new pline then use ssget "F" to get the touching mlines, the trim point is mid of the 2 mlines points. ; https://www.cadtutor.net/forum/topic/77526-how-to-trim-the-intersected-line-between-mline-polyline/ ; Trim mlines touching plines ; by AlanH May 2023 (defun c:cuts ( / ) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq ss (ssget '((0 . "lwpolyline")))) (if ss (repeat (setq x (sslength ss)) (setq ent (ssname ss (setq x (1- x)))) (setq obj (vlax-ename->vla-object ent)) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (setq co-ord (cons (last co-ord) co-ord)) (command "offset" 10 ent (getvar 'extmax) "") (setq co-ord2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (entlast))))) (setq co-ord2 (cons (last co-ord2) co-ord2)) (entdel (entlast)) (setq ss2 (ssget "f" co-ord2 '((0 . "MLINE")))) (setq mpts '()) (repeat (setq j (sslength ss2)) (setq ent2 (ssname ss2 (setq j (1- j)))) (setq obj2 (vlax-ename->vla-object ent2)) (setq intpts (vlax-invoke obj 'intersectWith obj2 acExtendThisEntity)) (setq mp (mapcar '* (mapcar '+ (list (nth 0 intpts) (nth 1 intpts) 0.0)(list (nth 3 intpts) (nth 4 intpts) 0.0)) '(0.5 0.5 0.5))) (setq mpts (cons mp mpts)) ) (command "trim" ss2 "") (foreach pt mpts (command pt) ) (command "") ) (alert "no plines") ) (princ) ) (c:cuts)
    1 point
×
×
  • Create New...