Jump to content

custom 2d osnap

exceed

By exceed
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted (edited)

2dosnap.gif

  

; custom 2d osnap - 2022.06.23 exceed
; https://www.cadtutor.net/forum/topic/75485-custom-2d-osnap/
; I make this I didn't want to wait for 2 points osnaps or osnap tracking. 
; because this is for speeding up very little time, dcl was not used also
; 
; steps
; 1. set rectangle range or line range by 2 pick points
; 2. pick area (if picked point is out of the rectangle area. it will get nearest point)
; 3. draw polyline (or place X symbol)
;
; command list
; 12 = 1/2 point
; 13 = 1/3 point
; 23 = 2/3 point
; 14 = 1/4 point
; ....etc
; 910 = 9/10 point
;
; without suffix "x" = start polyline from that point
; with suffix "x" = make X symbol with line at that point
;
; p.s.
; It was created to designate the length value at an arbitrary location at the beginning of the project.
; Generally, a lot of spares are assumed by designating the farthest end point, but if the site size is too large, 2/3 or 3/4 points are used. for both the x and y axes.
; It is intended to work in the x-y plane, but it also works for lines.
; For lines, it may be better to specify only the denominator, not the numerator. But updating this code like that gives 100 points for 10x10. 
; Too many choices makes it more difficult to count the number of desired numerators, thus undermining the meaning of osnap. 
; Therefore, it would be better to separate it into another lisp, so I did not write it here.



(defun c:12 () (ex:aofb 1 2 "P") )
(defun c:12x () (ex:aofb 1 2 "X") )
(defun c:13 () (ex:aofb 1 3 "P") ) 
(defun c:13x () (ex:aofb 1 3 "X") )
(defun c:23 () (ex:aofb 2 3 "P") ) ; same with 13
(defun c:23x () (ex:aofb 2 3 "X") ) ; same with 13x
(defun c:14 () (ex:aofb 1 4 "P") )
(defun c:14x () (ex:aofb 1 4 "X") )
(defun c:24 () (ex:aofb 2 4 "P") ) ; same with 12
(defun c:24x () (ex:aofb 2 4 "X") ) ; same with 12x
(defun c:34 () (ex:aofb 3 4 "P") ) ; same with 14
(defun c:34x () (ex:aofb 3 4 "X") ) ; same with 14x
(defun c:15 () (ex:aofb 1 5 "P") )
(defun c:15x () (ex:aofb 1 5 "X") )
(defun c:25 () (ex:aofb 2 5 "P") )
(defun c:25x () (ex:aofb 2 5 "X") )
(defun c:35 () (ex:aofb 3 5 "P") ) ; same with 25
(defun c:35x () (ex:aofb 3 5 "X") ) ; same with 25x
(defun c:45 () (ex:aofb 4 5 "P") ) ; same with 15
(defun c:45x () (ex:aofb 4 5 "X") ) ; same with 15x
(defun c:16 () (ex:aofb 1 6 "P") )
(defun c:16x () (ex:aofb 1 6 "X") )
(defun c:26 () (ex:aofb 1 6 "P") ) ; same with 13
(defun c:26x () (ex:aofb 1 6 "X") ) ; same with 13x
(defun c:36 () (ex:aofb 3 6 "P") ) ; same with 12
(defun c:36x () (ex:aofb 3 6 "X") ) ; same with 12x
(defun c:46 () (ex:aofb 4 6 "P") ) ; same with 23
(defun c:46x () (ex:aofb 4 6 "X") ) ; same with 23x
(defun c:56 () (ex:aofb 5 6 "P") ) ; same with 16
(defun c:56x () (ex:aofb 5 6 "X") ) ; same with 16x
(defun c:17 () (ex:aofb 1 7 "P") )
(defun c:17x () (ex:aofb 1 7 "X") )
(defun c:27 () (ex:aofb 2 7 "P") )
(defun c:27x () (ex:aofb 2 7 "X") )
(defun c:37 () (ex:aofb 3 7 "P") )
(defun c:37x () (ex:aofb 3 7 "X") )
(defun c:47 () (ex:aofb 4 7 "P") ) ; same with 37
(defun c:47x () (ex:aofb 4 7 "X") ) ; same with 37x
(defun c:57 () (ex:aofb 5 7 "P") ) ; same with 27
(defun c:57x () (ex:aofb 5 7 "X") ) ; same with 27x
(defun c:67 () (ex:aofb 6 7 "P") ) ; same with 17
(defun c:67x () (ex:aofb 6 7 "X") ) ; same with 17x
(defun c:18 () (ex:aofb 1 8 "P") )
(defun c:18x () (ex:aofb 1 8 "X") )
(defun c:28 () (ex:aofb 2 8 "P") ) ; same with 14
(defun c:28x () (ex:aofb 2 8 "X") ) ; same with 14x
(defun c:38 () (ex:aofb 3 8 "P") )
(defun c:38x () (ex:aofb 3 8 "X") )
(defun c:48 () (ex:aofb 4 8 "P") ) ; same with 12
(defun c:48x () (ex:aofb 4 8 "X") ) ; same with 12x
(defun c:58 () (ex:aofb 5 8 "P") ) ; same with 38
(defun c:58x () (ex:aofb 5 8 "X") ) ; same with 38x
(defun c:78 () (ex:aofb 7 8 "P") ) ; same with 14 
(defun c:78x () (ex:aofb 7 8 "X") ) ; same with 14x
(defun c:19 () (ex:aofb 1 9 "P") )
(defun c:19x () (ex:aofb 1 9 "X") )
(defun c:29 () (ex:aofb 2 9 "P") )
(defun c:29x () (ex:aofb 2 9 "X") )
(defun c:39 () (ex:aofb 3 9 "P") ) ; same with 13
(defun c:39x () (ex:aofb 3 9 "X") ) ; same with 13x
(defun c:49 () (ex:aofb 4 9 "P") )
(defun c:49x () (ex:aofb 4 9 "X") )
(defun c:59 () (ex:aofb 5 9 "P") ) ; same with 49
(defun c:59x () (ex:aofb 5 9 "X") ) ; same with 49x
(defun c:69 () (ex:aofb 6 9 "P") ) ; same with 23
(defun c:69x () (ex:aofb 6 9 "X") ) ; same with 23x
(defun c:79 () (ex:aofb 7 9 "P") ) ; same with 29
(defun c:79x () (ex:aofb 7 9 "X") ) ; same with 29x
(defun c:89 () (ex:aofb 8 9 "P") ) ; same with 19
(defun c:89x () (ex:aofb 8 9 "X") ) ; same with 19x

;divide with ten
(defun c:010 () (ex:aofb 0 10 "P") ) 
(defun c:010x () (ex:aofb 0 10 "X") )
(defun c:110 () (ex:aofb 1 10 "P") )
(defun c:110x () (ex:aofb 1 10 "X") )
(defun c:210 () (ex:aofb 2 10 "P") )
(defun c:210x () (ex:aofb 2 10 "X") )
(defun c:310 () (ex:aofb 3 10 "P") )
(defun c:310x () (ex:aofb 3 10 "X") )
(defun c:410 () (ex:aofb 4 10 "P") )
(defun c:410x () (ex:aofb 4 10 "X") )
(defun c:510 () (ex:aofb 5 10 "P") )
(defun c:510x () (ex:aofb 5 10 "X") )
(defun c:610 () (ex:aofb 6 10 "P") )
(defun c:610x () (ex:aofb 6 10 "X") )
(defun c:710 () (ex:aofb 7 10 "P") )
(defun c:710x () (ex:aofb 7 10 "X") )
(defun c:810 () (ex:aofb 8 10 "P") )
(defun c:810x () (ex:aofb 8 10 "X") )
(defun c:910 () (ex:aofb 9 10 "P") )
(defun c:910x () (ex:aofb 9 10 "X") )
(defun c:1010 () (ex:aofb 10 10 "P") )
(defun c:1010x () (ex:aofb 10 10 "X") )


(vl-load-com)
(defun ex:aofb ( a b type / oldosmode *error* mspace pt1 pt2 xmin xmax ymin ymax recpt1 recpt2 recpt3 recpt4 crossx crossy crosspt1 crosspt2 crosspt3 crosspt4 pt3 pt3x pt3y area1min area1max area2min area2max area3min area3max area4min area4max x31length y31length area1pt area2pt area3pt area4pt picked32pt xsize xpt11 xpt12 xpt21 xpt22 xline1 xline2 dist1 dist2 dist3 dist4 mindist areaptlist index areapt area1x11 area1x12 area1x21 area1x22 )
  (LM:startundo (LM:acdoc))
  (setq oldosmode (getvar 'osmode))
  ;error control
  (defun *error* ( msg )
    (LM:endundo (LM:acdoc))
    (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (princ (strcat "\n Error: " msg))
    )
    (setvar 'osmode oldosmode)
    (redraw)
    (princ)
  )
  (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))

  (princ "\n find ")
  (princ a)
  (princ "/")
  (princ b)
  (princ " points of area")
  (setq pt1 (getpoint "\n pick area's first point "))
  (setq pt2 (getcorner pt1 "\n pick area's second point "))
  (cond 
    ((<= (car pt1) (car pt2))
      (setq xmin (car pt1))
      (setq xmax (car pt2))
    )
    ((> (car pt1) (car pt2))
      (setq xmin (car pt2))
      (setq xmax (car pt1))
    )
    ((= (car pt1) (car pt2))
      (setq xmin (car pt1))
      (setq xmax (car pt2))
      (princ "\n x value is same. so find point in the line")
    )
  )
  (cond 
    ((<= (cadr pt1) (cadr pt2))
      (setq ymin (cadr pt1))
      (setq ymax (cadr pt2))
    )
    ((> (cadr pt1) (cadr pt2))
      (setq ymin (cadr pt2))
      (setq ymax (cadr pt1))
    )
    ((= (cadr pt1) (cadr pt2))
      (setq ymin (cadr pt1))
      (setq ymax (cadr pt2))
      (princ "\n y value is same. so find point in the line")
    )
  )

  (setq recpt1 (list xmin ymin))
  (setq recpt2 (list xmax ymin))
  (setq recpt3 (list xmax ymax))
  (setq recpt4 (list xmin ymax))
  (setq crossx (/ (+ xmin xmax) 2))
  (setq crossy (/ (+ ymin ymax) 2))
  (setq crosspt1 (list crossx ymin))
  (setq crosspt2 (list crossx ymax))
  (setq crosspt3 (list xmin crossy))
  (setq crosspt4 (list xmax crossy))

  (grvecs (list 120 recpt1 recpt2 recpt2 recpt3 recpt3 recpt4 recpt4 recpt1 crosspt1 crosspt2 crosspt3 crosspt4))
  (setvar 'osmode 0)

  
  (setq area1min (list xmin ymin))
  (setq area1max (list crossx crossy))
  (setq area2min (list crossx ymin))
  (setq area2max (list xmax crossy))
  (setq area3min (list xmin crossy))
  (setq area3max (list crossx ymax))
  (setq area4min (list crossx crossy))
  (setq area4max (list xmax ymax))

  (setq a (float a))
  (setq b (float b))
  (setq x31length (/ (- xmax xmin) b))
  (setq y31length (/ (- ymax ymin) b))

  (cond 
    ((> 0.5 (/ a b))
      (setq area1pt (list (+ xmin (* x31length a)) (+ ymin (* y31length a)) ))
      (setq area2pt (list (+ xmin (* x31length (- b a))) (+ ymin (* y31length a)) ))
      (setq area3pt (list (+ xmin (* x31length a)) (+ ymin (* y31length (- b a))) ))
      (setq area4pt (list (+ xmin (* x31length (- b a))) (+ ymin (* y31length (- b a))) ))
    )
    ((< 0.5 (/ a b))
      (setq area1pt (list (+ xmin (* x31length (- b a))) (+ ymin (* y31length (- b a))) ))
      (setq area2pt (list (+ xmin (* x31length a)) (+ ymin (* y31length (- b a))) ))
      (setq area3pt (list (+ xmin (* x31length (- b a))) (+ ymin (* y31length a)) ))
      (setq area4pt (list (+ xmin (* x31length a)) (+ ymin (* y31length a)) ))
    )
    ((= 0.5 (/ a b))
      (setq area1pt (list (+ xmin (* x31length a)) (+ ymin (* y31length a)) ))
      (setq area2pt (list (+ xmin (* x31length a)) (+ ymin (* y31length a)) ))
      (setq area3pt (list (+ xmin (* x31length a)) (+ ymin (* y31length a)) ))
      (setq area4pt (list (+ xmin (* x31length a)) (+ ymin (* y31length a)) ))
    )
  )


  (setq xsize (/ (/ (+ (- xmax xmin) (- ymax ymin)) 2) 20))
  (setq areaptlist (list area1pt area2pt area3pt area4pt))
  (setq index 0)
  (repeat 4
    (setq areapt (nth index areaptlist))
    (setq area1x11 (list (- (car areapt) xsize) (- (cadr areapt) xsize)))
    (setq area1x12 (list (+ (car areapt) xsize) (+ (cadr areapt) xsize)))
    (setq area1x21 (list (- (car areapt) xsize) (+ (cadr areapt) xsize)))
    (setq area1x22 (list (+ (car areapt) xsize) (- (cadr areapt) xsize)))
    (grvecs (list 120 area1x11 area1x12 area1x21 area1x22))
    (setq index (+ index 1))
  )

  (setq pt3 (getpoint "\n pick area you make it."))
  (setq pt3x (car pt3))
  (setq pt3y (cadr pt3))

  (cond 
    ((and (<= (car area1min) pt3x) (> (car area1max) pt3x) (<= (cadr area1min) pt3y) (> (cadr area1max) pt3y))
      (setq picked32pt area1pt)
      (princ " : Lower Left area is selected")
    )
    ((and (<= (car area2min) pt3x) (> (car area2max) pt3x) (<= (cadr area2min) pt3y) (> (cadr area2max) pt3y))
      (setq picked32pt area2pt)
      (princ " : Lower Right area is selected")
    )
    ((and (<= (car area3min) pt3x) (> (car area3max) pt3x) (<= (cadr area3min) pt3y) (> (cadr area3max) pt3y))
      (setq picked32pt area3pt)
      (princ " : Upper Left area is selected")
    )
    ((and (<= (car area4min) pt3x) (> (car area4max) pt3x) (<= (cadr area4min) pt3y) (> (cadr area4max) pt3y))
      (setq picked32pt area4pt)
      (princ " : Upper Right area is selected")
    )
    (t 
      (princ "\n it's not in the Area, so select nearest point")
      (setq dist1 (distance area1pt pt3))
      (setq dist2 (distance area2pt pt3))
      (setq dist3 (distance area3pt pt3))
      (setq dist4 (distance area4pt pt3))
      (setq mindist (min dist1 dist2 dist3 dist4))
      (cond 
        ((= mindist dist1)
          (setq picked32pt area1pt)
        )
        ((= mindist dist2)
          (setq picked32pt area2pt)
        )
        ((= mindist dist3)
          (setq picked32pt area3pt)
        )
        ((= mindist dist4)
          (setq picked32pt area4pt)
        )
      )

    )
  )

  (cond 
    ((= type "P")
      (command "_.PLINE" picked32pt)
    )
    ((= type "X")
      (setq xpt11 (list (- (car picked32pt) xsize) (- (cadr picked32pt) xsize)))
      (setq xpt12 (list (+ (car picked32pt) xsize) (+ (cadr picked32pt) xsize)))
      (setq xpt21 (list (- (car picked32pt) xsize) (+ (cadr picked32pt) xsize)))
      (setq xpt22 (list (+ (car picked32pt) xsize) (- (cadr picked32pt) xsize)))
      (setq xline1 (vla-addline mspace (vlax-3d-point xpt11)(vlax-3d-point xpt12)))
      (setq xline2 (vla-addline mspace (vlax-3d-point xpt21)(vlax-3d-point xpt22)))
    )
    (t (princ "\n type is incorrect, only "P" or "X" are allowed")
      (setq xpt11 (list (- (car picked32pt) xsize) (- (cadr picked32pt) xsize)))
      (setq xpt12 (list (+ (car picked32pt) xsize) (+ (cadr picked32pt) xsize)))
      (setq xpt21 (list (- (car picked32pt) xsize) (+ (cadr picked32pt) xsize)))
      (setq xpt22 (list (+ (car picked32pt) xsize) (- (cadr picked32pt) xsize)))
      (setq xline1 (vla-addline mspace (vlax-3d-point xpt11)(vlax-3d-point xpt12)))
      (setq xline2 (vla-addline mspace (vlax-3d-point xpt21)(vlax-3d-point xpt22)))
    )
  );end of cond

  (LM:endundo (LM:acdoc))
  (setvar 'osmode oldosmode)
  (redraw)

  (princ)
)


(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

 

Edited by exceed
  • exceed changed the title to custom 2d osnap
BIGAL Grand Master

BIGAL

Posted
Posted

Look into CAL has 2 functions that may do what you are doing.

 

Type 'cal then function plt(p1,p2,t)

 

Calculate a Point on a Line (CAL Command) | AutoCAD 2020 | Autodesk Knowledge Network

 

My old R2012 manual has pretty pictures.

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...