Theoretical and actual Point X and Y differeces!

[Margusrebase]

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

 

NB! Look attachment!

[Roy_043]

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

[Margusrebase]

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

[eldon]

Search forum threads for "asbuilt"

[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)
)

[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)
)

[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 !

[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

[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

[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 "")

[hanhphuc]

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

consider osmode angdir mirrtext etc..

 

;; Make Angle Readable by: ymg  

(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) ;*global variable= s & ip 

 ;simply calling standard command "mirror" to manipulate or flip the reference annotation

   (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)))

		     ) 

		    )

		   )

		  

 ; Draw arrow by standard command: PLINE 

		  (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:dxy (/ 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)

 ) 

 

Edited November 15, 2022 by hanhphuc
BBcode removed

[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)
)

[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