Jump to content
Margusrebase

Theoretical and actual Point X and Y differeces!

Recommended Posts

Margusrebase

I need autolisp that can calculate differences between theoretical point and actualpoint and draw arrows and put x;y values.

 

NB! Look attachment!

image1.JPG

Share this post


Link to post
Share on other sites
Roy_043

You may want to explain what you mean by 'theoretical point' and 'actual point'.

Share this post


Link to post
Share on other sites
Margusrebase

Actually these are two point and i need differences between points! Autolisp draw arrows and value x;y!

Share this post


Link to post
Share on other sites
eldon

Search forum threads for "asbuilt"

Share this post


Link to post
Share on other sites
ronjonp

Subtract your x's and y's?

(defun c:foo (/ s)
 (if (and (setq s (ssget '((0 . "point")))) (= 2 (sslength s)))
   (progn (setq s (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
		   (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   )
   )
   (alert (vl-princ-to-string (mapcar 'abs (mapcar '- (car s) (cadr s)))))
   )
 )
 (princ)
)

Share this post


Link to post
Share on other sites
Aftertouch

Something like this?

(defun c:CADTUTOR ( / )
(setq point1 (getpoint "Select first point: "))
(setq point2 (getpoint "Select second point: "))
(command "_DIMLINEAR" point1 point2 "H" point2)
(command "_DIMLINEAR" point1 point2 "V" point2)
(princ)
)

Share this post


Link to post
Share on other sites
BIGAL

Way to go for lots of points is make a selection set of real points make a selection set of theorectical, you can then check how close the points are using a tolerance, the choice is your then x1,y1 -> x2,y2 = dist to file, on screen or dim like Aftertouch. Also did not find's !

Share this post


Link to post
Share on other sites
Margusrebase

This is almost that i need but ... can you edit code like this: autolisp draw arrows and differences (mm) end of arrow!

 

See attachment above!

 

Thanks!

Margus

Share this post


Link to post
Share on other sites
Margusrebase
Something like this?

(defun c:CADTUTOR ( / )
(setq point1 (getpoint "Select first point: "))
(setq point2 (getpoint "Select second point: "))
(command "_DIMLINEAR" point1 point2 "H" point2)
(command "_DIMLINEAR" point1 point2 "V" point2)
(princ)
)

 

 

 

This is almost that i need but ... can you edit code like this: autolisp draw arrows and differences (mm) end of arrow!

 

See attachment above!

 

Thanks!

Margus

Share this post


Link to post
Share on other sites
BIGAL

Rather than a dim look into a leader, pt3 would be an offset from pt2 at angle pt1-pt2

 

(command "leader" pt1 pt2 pt3 "a" diff "")

Share this post


Link to post
Share on other sites
hanhphuc

my attempt have some fun with command call, but may need to

consider osmode angdir mirrtext etc..

 

[color="green"];; Make Angle Readable by: ymg  [/color]
(defun MakeReadable (a)
 (setq a (rem (+ a pi pi) (+ pi pi)))
 (rem (if (< (* pi 0.5) a (* pi 1.5))
 (+ a pi)
 a
 ) 
      (+ pi pi)
      ) 
 ) 

(defun _mirror (x / en ie)[color="green"] ;*global variable= s & ip[/color] 
[color="green"] ;simply calling standard command "mirror" to manipulate or flip the reference annotation[/color]
   (cons 'progn
  (list	(cons 'setq '(ie 0))
	(cons 'repeat
	      (list (sslength s)
		    (cons 'vl-cmdf
			  (list	"_.mirror"
				'(setq en (ssname s ie))
				""
				(cons 'list ip)
				(cons 'polar (list (cons 'list ip) x 1.0))
				"Y"
				) 
			  ) 
		    (cons 'setq '(ie (1+ ie)))
		    ) 
	      ) 
	) 
  ) 
   ) ;_ end of defun


(defun delta (p1 p2 ip / xy id dxy s i a l e)
;hanhphuc 
     (setq xy     '((p) (list (car p) (cadr p)))
    id	(mapcar	''((x) (equal x (apply 'mapcar (cons '>= (mapcar 'xy (list p2 p1))))))
		'((T T) (nil T) (nil nil) (T nil))
		)
    
    dxy	(mapcar '- p1 p2)
    
    s	(apply ''((txh pt dX dY / ss next ro yd p) 
		  (setvar 'osmode 0) 
		  (setq
		   yd
		   (getvar 'ucsydir)
		   ro
		   (MakeReadable
		    (if
		     (equal (car yd) 0.0 1e-10)
		     0.0
		     (atan (/ (car yd) (cadr yd)))
		     ) 
		    )
		   )
		  
[color="green"] ; Draw arrow by standard command: PLINE [/color]
		  (vl-cmdf
		   "_PLINE"
		   (list (car pt) (+ (cadr pt) (* 2. txh)))
		   "w"
		   0.0
		   (* 0.3 txh)
		   (list (car pt) (+ (cadr pt) txh))
		   "w"
		   0.0
		   0.0
		   pt
		   "w"
		   0.0
		   0.0
		   (list (+ (car pt) txh) (cadr pt))
		   "w"
		   (* 0.3 txh)
		   0.0
		   (list (+ (car pt) (* 2. txh)) (cadr pt))
		   ""
		   ) ; command
		  
		  (setq next (ssadd))
		  (foreach
		   ss
		   (vl-list*
		    (entlast)
		    (mapcar
		     ''((a b c d)
			(entmakex
			 (mapcar
			  'cons
			  '(0 1 8 10 11 40 50 62 72 73) 
			  (list "TEXT" a "DIFF" (setq p (polar (trans pt 1 0) (- b ro) c)) p txh (- d ro) 256 1 2)
			  )
			 )
			)
		     (list dY dX)
		     (list  (* pi 0.5) 0.) 
		     (list (* 4.0 txh) (* 4.0 txh)) 
		     (list (* pi 0.5) 0.0)
		     
		     ) ; mapcar  
		    ) ; vl-list* 
		   (ssadd ss next)
		   ) 
		  next
		  ) 
	       (vl-list* (getvar 'textsize)
			 ip
			 (mapcar ''((f) (rtos (abs (* (f dxy) 1000.)) 2 0)) (list car cadr))
			 )
	       )
    ) 
     (eval (cons 'cond
	  (vl-list* (list (nth 0 id) T)
		    (mapcar ''((a b)
			       (list
				(setq i (nth a id))
				(_mirror b)
				(if
				 (and i (nth 2 id))
				 (_mirror (* pi 0.5))
				 )
				)
			       )
			    '(1 2 3)
			    (list (* pi 0.5) 0.0 pi)
			    )
		    )
	  ) 
    ) ;eval
    (repeat (setq i (sslength s))
   (setq e (ssname s (setq i (1- i)))
  l (entget e)
  a (cdr (assoc 50 l))
  ) 
   (if	(assoc 1 l)
     (entmod (subst (cons 50 (MakeReadable a)) (assoc 50 l) l))
     ) 
   ) ;repeat

     )


(defun c:test (/ p1 p2 p3 )

 (terpri)
 (while (and (setq p1 (getpoint "\rTheoretical point..       "))
      (setq p2 (getpoint p1 "\rActual point..            "))
      (setq p3 (getpoint p2 "\rPlacing arrow..           "))
      )
   (delta p1 p2 p3)
   ) 
 (princ)
 ) 

Share this post


Link to post
Share on other sites
ronjonp

Another:

(defun c:foo (/ _text d p1 p2 s)
 (defun _text (p h s)
   (entmakex (list '(0 . "TEXT")
	    '(100 . "AcDbEntity")
	    '(67 . 0)
	    '(62 . 1)
	    '(8 . "text")
	    '(100 . "AcDbText")
	    (cons 10 p)
	    (cons 40
		  (if (> (getvar 'dimscale) 0)
		    (* h (getvar 'dimscale))
		    h
		  )
	    )
	    (cons 1 (vl-princ-to-string s))
	    '(50 . 0.0)
	    '(41 . 1.0)
	    '(51 . 0.0)
	    '(7 . "Standard")
	    '(71 . 0)
	    '(72 . 1)
	    (cons 11 p)
	    '(100 . "AcDbText")
	    '(73 . 2)
      )
   )
 )
 (if (setq s (ssget '((0 . "point"))))
   (progn (setq s (mapcar '(lambda (x) (cdr (assoc 10 (entget x))))
		   (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   )
	 s (vl-sort s '(lambda (a b) (< (cadr a) (cadr b))))
   )
   (while (cadr s)
     (setq p1 (car s))
     (setq
       p2 (car (vl-sort (setq s (cdr s)) '(lambda (a b) (< (distance p1 a) (distance p1 b)))))
     )
     (setq d (mapcar 'abs (mapcar '- p1 p2)))
     (entmakex (list '(0 . "LWPOLYLINE")
		     '(100 . "AcDbEntity")
		     '(67 . 0)
		     '(62 . 
		     '(8 . "difference")
		     '(100 . "AcDbPolyline")
		     '(90 . 3)
		     (cons 10 p1)
		     (cons 10 (list (car p2) (cadr p1)))
		     (cons 10 p2)
	       )
     )
     (_text p1 0.1 (car d))
     (_text p2 0.1 (cadr d))
     (setq s (vl-remove p2 s))
   )
   )
 )
 (princ)
)

2017-10-23_11-37-04.gif

Share this post


Link to post
Share on other sites
Margusrebase
my attempt have some fun with command call, but may need to

consider osmode angdir mirrtext etc..

 

[color="green"];; Make Angle Readable by: ymg  [/color]
(defun MakeReadable (a)
 (setq a (rem (+ a pi pi) (+ pi pi)))
 (rem (if (< (* pi 0.5) a (* pi 1.5))
 (+ a pi)
 a
 ) 
      (+ pi pi)
      ) 
 ) 

(defun _mirror (x / en ie)[color="green"] ;*global variable= s & ip[/color] 
[color="green"] ;simply calling standard command "mirror" to manipulate or flip the reference annotation[/color]
   (cons 'progn
  (list	(cons 'setq '(ie 0))
	(cons 'repeat
	      (list (sslength s)
		    (cons 'vl-cmdf
			  (list	"_.mirror"
				'(setq en (ssname s ie))
				""
				(cons 'list ip)
				(cons 'polar (list (cons 'list ip) x 1.0))
				"Y"
				) 
			  ) 
		    (cons 'setq '(ie (1+ ie)))
		    ) 
	      ) 
	) 
  ) 
   ) ;_ end of defun


(defun delta (p1 p2 ip / xy id dxy s i a l e)
;hanhphuc 
     (setq xy     '((p) (list (car p) (cadr p)))
    id	(mapcar	''((x) (equal x (apply 'mapcar (cons '>= (mapcar 'xy (list p2 p1))))))
		'((T T) (nil T) (nil nil) (T nil))
		)
    
    dxy	(mapcar '- p1 p2)
    
    s	(apply ''((txh pt dX dY / ss next ro yd p) 
		  (setvar 'osmode 0) 
		  (setq
		   yd
		   (getvar 'ucsydir)
		   ro
		   (MakeReadable
		    (if
		     (equal (car yd) 0.0 1e-10)
		     0.0
		     (atan (/ (car yd) (cadr yd)))
		     ) 
		    )
		   )
		  
[color="green"] ; Draw arrow by standard command: PLINE [/color]
		  (vl-cmdf
		   "_PLINE"
		   (list (car pt) (+ (cadr pt) (* 2. txh)))
		   "w"
		   0.0
		   (* 0.3 txh)
		   (list (car pt) (+ (cadr pt) txh))
		   "w"
		   0.0
		   0.0
		   pt
		   "w"
		   0.0
		   0.0
		   (list (+ (car pt) txh) (cadr pt))
		   "w"
		   (* 0.3 txh)
		   0.0
		   (list (+ (car pt) (* 2. txh)) (cadr pt))
		   ""
		   ) ; command
		  
		  (setq next (ssadd))
		  (foreach
		   ss
		   (vl-list*
		    (entlast)
		    (mapcar
		     ''((a b c d)
			(entmakex
			 (mapcar
			  'cons
			  '(0 1 8 10 11 40 50 62 72 73) 
			  (list "TEXT" a "DIFF" (setq p (polar (trans pt 1 0) (- b ro) c)) p txh (- d ro) 256 1 2)
			  )
			 )
			)
		     (list dY dX)
		     (list  (* pi 0.5) 0.) 
		     (list (* 4.0 txh) (* 4.0 txh)) 
		     (list (* pi 0.5) 0.0)
		     
		     ) ; mapcar  
		    ) ; vl-list* 
		   (ssadd ss next)
		   ) 
		  next
		  ) 
	       (vl-list* (getvar 'textsize)
			 ip
			 (mapcar ''((f) (rtos (abs (* (f dxy) 1000.)) 2 0)) (list car cadr))
			 )
	       )
    ) 
     (eval (cons 'cond
	  (vl-list* (list (nth 0 id) T)
		    (mapcar ''((a b)
			       (list
				(setq i (nth a id))
				(_mirror b)
				(if
				 (and i (nth 2 id))
				 (_mirror (* pi 0.5))
				 )
				)
			       )
			    '(1 2 3)
			    (list (* pi 0.5) 0.0 pi)
			    )
		    )
	  ) 
    ) ;eval
    (repeat (setq i (sslength s))
   (setq e (ssname s (setq i (1- i)))
  l (entget e)
  a (cdr (assoc 50 l))
  ) 
   (if	(assoc 1 l)
     (entmod (subst (cons 50 (MakeReadable a)) (assoc 50 l) l))
     ) 
   ) ;repeat

     )


(defun c:test (/ p1 p2 p3 )

 (terpri)
 (while (and (setq p1 (getpoint "\rTheoretical point..       "))
      (setq p2 (getpoint p1 "\rActual point..            "))
      (setq p3 (getpoint p2 "\rPlacing arrow..           "))
      )
   (delta p1 p2 p3)
   ) 
 (princ)
 ) 

 

Hi,

 

This is olmosta done but, is it possible edit code like this: activ osnap stay ON and number is always same direction!

 

Best,

Margus

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×