Margusrebase Posted October 19, 2017 Share Posted October 19, 2017 I need autolisp that can calculate differences between theoretical point and actualpoint and draw arrows and put x;y values. NB! Look attachment! Quote Link to comment Share on other sites More sharing options...
Roy_043 Posted October 19, 2017 Share Posted October 19, 2017 You may want to explain what you mean by 'theoretical point' and 'actual point'. Quote Link to comment Share on other sites More sharing options...
Margusrebase Posted October 19, 2017 Author Share Posted October 19, 2017 Actually these are two point and i need differences between points! Autolisp draw arrows and value x;y! Quote Link to comment Share on other sites More sharing options...
eldon Posted October 19, 2017 Share Posted October 19, 2017 Search forum threads for "asbuilt" Quote Link to comment Share on other sites More sharing options...
ronjonp Posted October 19, 2017 Share Posted October 19, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
Aftertouch Posted October 19, 2017 Share Posted October 19, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 20, 2017 Share Posted October 20, 2017 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 ! Quote Link to comment Share on other sites More sharing options...
Margusrebase Posted October 20, 2017 Author Share Posted October 20, 2017 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 Quote Link to comment Share on other sites More sharing options...
Margusrebase Posted October 20, 2017 Author Share Posted October 20, 2017 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 21, 2017 Share Posted October 21, 2017 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 "") Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted October 23, 2017 Share Posted October 23, 2017 (edited) 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 Quote Link to comment Share on other sites More sharing options...
ronjonp Posted October 23, 2017 Share Posted October 23, 2017 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) ) Quote Link to comment Share on other sites More sharing options...
Margusrebase Posted October 24, 2017 Author Share Posted October 24, 2017 my attempt have some fun with command call, but may need toconsider 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.