Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 11/19/2021 in all areas

  1. Hello, sorry for the large format but dont have time to create more clear lisp. (defun c:try1 ( / sel sel1 intList) (setq sel (ssget (list (cons 0 "Line")))) (setq sel1 (VaniVL sel "Trudy")) (if sel (setq intList (LM:intersectionsinset sel)) ) (vlax-for x sel1 (setq intList (append intList (list (vlax-get x 'EndPoint) (vlax-get x'StartPoint)))) ) (setq intList (T:filer intList)) (mapcar '(lambda (x) (entmake (list '(0 . "POINT") (cons 10 x)))) intList) (princ) ) (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 LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn ) (repeat (setq id1 (sslength sel)) (setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1))))) (repeat (setq id2 id1) (setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2)))) rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn) ) ) ) (apply 'append (reverse rtn)) ) (defun VaniVL ( SS SSnm / i L SScoll SfArrayObjs vSS ) (cond ( (not (eq 'PICKSET (type SS))) nil) ( (not (and (eq 'STR (type SSnm)) (snvalid SSnm))) nil) (T (repeat (setq i (sslength SS)) (setq L (cons (vlax-ename->vla-object (ssname SS (setq i (1- i)))) L)) ) (setq SScoll (vla-get-SelectionSets (vla-get-ActiveDocument (vlax-get-acad-object)))) (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-Item (list SScoll SSnm)))) (vla-Delete (vla-Item SScoll SSnm)) ) (setq vSS (vla-Add SScoll SSnm)) (setq SfArrayObjs (vlax-make-safearray vlax-vbObject (cons 0 (1- (length L))))) (setq i -1) (foreach o L (vlax-safearray-put-element SfArrayObjs (setq i (1+ i)) o) ) (vla-AddItems vSS SfArrayObjs) vSS ) ); cond ); defun VanillaSS->VlaSS (defun T:filer (allcord / SinPoint) ;Delete dubllated things in list (while allcord (setq SinPoint (cons (car allcord) SinPoint)) (setq allcord (vl-remove (car allcord) allcord)) ) SinPoint )
    2 points
  2. In addition, you can simply highlight thr text you want to quote, and a "Quote selection" button will appear. Click it and the quoted text is added to your reply
    1 point
  3. Simple enough to put points at the ends. But Intersections no idea. (defun C:PTZ (/ SS lst) (if (setq SS (ssget '((0 . "LINE")))) (progn (foreach line (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq lst (cons (cdr (assoc 10 (entget line))) lst) lst (cons (cdr (assoc 11 (entget line))) lst) ) ) (foreach PT lst (entmake (list (cons 0 "POINT") (cons 10 PT) ) ) ) ) ) (princ) )
    1 point
  4. I was about to say what Lee said... he beat me to it... But it's an interesting challenge, I'll think about it.
    1 point
  5. vla-transformby cannot apply a non-uniform transformation.
    1 point
  6. Comment or delete this line. (apply '= (mapcar 'abs (list (vla-get-XScaleFactor br) (vla-get-YScaleFactor br) (vla-get-ZScaleFactor br))))
    1 point
  7. Glad to help. If you get stuck doing next step just ask.
    1 point
  8. Picking start pt, next pt and a preset dim offset is what you want, set next to start pt, then continue picking next point and repeat. I dont have anything that matches but its a bit like make a pline from pick pts. You would use dim align not hor or ver. Something like this. ; https://www.cadtutor.net/forum/topic/73968-is-it-possible-to-change-dimension-orientation-while-performing-dimcontinue/ ; multi dim by AlanH Nov 2021 (defun c:mdim ( / off pi2 oldsanp pt1 pt2 pt3) (setq off 5.5 pi2 (/ pi 2.0)) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 1) (setq pt1 (getpoint "\nPick 1st point ")) (while (setq pt2 (getpoint "\nPick next point Enter to exit")) (setq ang (angle pt1 pt2)) (setq mp (mapcar '* (mapcar '+ pt1 pt2) '(0.5 0.5 0.5))) (setq pt3 (polar mp (+ ang pi2) off)) (setvar 'osmode 0) (command "dim" "align" pt1 pt2 pt3 "" "exit") (setq pt1 pt2) (setvar 'osmode 1) ) (setvar 'osmode oldsnap) (princ) ) (c:mdim)
    1 point
×
×
  • Create New...