nguyenkaca Posted September 15, 2011 Share Posted September 15, 2011 Hi every body, I'm new to this forum and know very little about programming lisp routine.I usually just come across ones every now and then and add them to my installation of AutoCAD 2007. Does anyone know of a routine that would be able to measure distance between two intersection points. Sample: Drawing1.dwg Please help me.I really need it because it take me a lot of time to do this. Thank for any and all help. KaCa Quote Link to comment Share on other sites More sharing options...
Tiger Posted September 15, 2011 Share Posted September 15, 2011 ah, so you want to auto-dimenson a irregular grid? I was gonne suggest DIST just based on your question, but that is not really want you want. Quote Link to comment Share on other sites More sharing options...
pBe Posted September 15, 2011 Share Posted September 15, 2011 This would be interesting. Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 15, 2011 Author Share Posted September 15, 2011 Could you give me a hand? How you can help me? Quote Link to comment Share on other sites More sharing options...
pBe Posted September 15, 2011 Share Posted September 15, 2011 I'm currently thinking how to go about it in one go. have you look at the links below . may be you can find one that suit your needs. it will cut the your waiting time in half. ------||------ ------||------ ----- \ /------ ------\/------- BTW: Welcome to the forum Quote Link to comment Share on other sites More sharing options...
luiscarneirorm Posted September 15, 2011 Share Posted September 15, 2011 You have the function of LeeMac, I think it does exactly what you have claimed. http://lee-mac.com/intersectionslength.html Quote Link to comment Share on other sites More sharing options...
pBe Posted September 15, 2011 Share Posted September 15, 2011 You have the function of LeeMac, I think it does exactly what you have claimed. http://lee-mac.com/intersectionslength.html And yeah... that too Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 15, 2011 Author Share Posted September 15, 2011 That's great. But it's easy to make a mistake because it hasn't got any arrows to show distance between two intersection points.so when i give my drawing to my worker they will make a mistake. Quote Link to comment Share on other sites More sharing options...
Tiger Posted September 15, 2011 Share Posted September 15, 2011 I found the command QDIm but it seems to only work with Linear dimensions. It is some kind of shortcut though. Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 15, 2011 Author Share Posted September 15, 2011 That's true. but it doesn't suit my needs. Tiger Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 15, 2011 Author Share Posted September 15, 2011 please help me. Quote Link to comment Share on other sites More sharing options...
pBe Posted September 15, 2011 Share Posted September 15, 2011 ...... patience my young padawan Quote Link to comment Share on other sites More sharing options...
ketxu Posted September 15, 2011 Share Posted September 15, 2011 Quick change a little from of LM rountine to suite with Kaca' request. I hope LM don't mind . I've mark what changed ;;-------------=={ Length Between Intersections }==-----------;; ;; ;; ;; Displays the length of segments of a curve divided at ;; ;; intersections with other objects. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;; ;;------------------------------------------------------------;; ;; Version 1.4 - 26-04-2011 ;; ;;------------------------------------------------------------;; (defun c:IntLen ( / *error* _iscurveobject e ) (defun *error* ( msg ) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun _IsCurveObject ( entity / param ) (and (not (vl-catch-all-error-p (setq param (vl-catch-all-apply 'vlax-curve-getendparam (list entity)) ) ) ) param ) ) (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER)))))) (princ "\n--> Current Layer Locked.") (while (progn (setvar 'ERRNO 0) (setq e (car (entsel))) (cond ( (= 7 (getvar 'ERRNO)) (princ "\n--> Missed, Try again.") ) ( (eq 'ENAME (type e)) (if (_iscurveobject e) (LM:IntersectionLengths e) (princ "\n--> Invalid Object Selected.") ) t ) ) ) ) ) (princ) ) ;;------------------------------------------------------------;; (defun c:IntLenM ( / *error* ss i ) (defun *error* ( msg ) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER)))))) (princ "\n--> Current Layer Locked.") (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")))) (repeat (setq i (sslength ss)) (LM:IntersectionLengths (ssname ss (setq i (1- i)))) ) ) ) (princ) ) ;;------------------------------------------------------------;; (defun LM:IntersectionLengths ( e ;; Entity name / *error* _startundo _endundo _groupbynum _sortbyparam _makereadable _isannotative _uniquefuzz a acspc c d d1 d2 da e i l ll m o ss ta to ts ur x y ) (setq acdoc (cond ( acdoc ) ( (vla-get-activedocument (vlax-get-acad-object)) )) acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)) ) (defun *error* ( msg ) (if acdoc (_EndUndo acdoc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (defun _StartUndo ( doc ) (_EndUndo doc) (vla-StartUndoMark doc) ) (defun _EndUndo ( doc ) (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-EndUndoMark doc)) ) (defun _GroupByNum ( l n / r) (if l (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (_GroupByNum l n) ) ) ) (defun _SortbyParam ( e l ) (vl-sort l '(lambda ( a b ) (< (vlax-curve-getParamatPoint e a) (vlax-curve-getParamatPoint e b)))) ) (defun _MakeReadable ( a ) ( (lambda ( a ) (cond ( (and (> a (/ pi 2)) (<= a pi)) (- a pi) ) ( (and (> a pi) (<= a (/ (* 3 pi) 2))) (+ a pi) ) ( a ) ) ) (rem a (* 2 pi)) ) ) (defun _isAnnotative ( style / object annotx ) (and (setq object (tblobjname "STYLE" style)) (setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative"))))) (= 1 (cdr (assoc 1070 (reverse annotx)))) ) ) (defun _uniquefuzz ( lst fuzz ) (if lst (cons (car lst) (_uniquefuzz (vl-remove-if '(lambda ( x ) (equal x (car lst) fuzz)) (cdr lst)) fuzz ) ) ) ) (setq ts (/ (getvar 'textsize) (if (_isAnnotative (getvar 'textstyle)) (cond ( (getvar 'cannoscalevalue) ) ( 1.0 )) 1.0 ) ) ) (_StartUndo acdoc) (vla-getBoundingBox (setq o (vlax-ename->vla-object e)) 'll 'ur) (mapcar '(lambda ( x ) (set x (vlax-safearray->list (eval x)))) '(ll ur)) (if (setq l (_sortbyparam e (_uniquefuzz (apply 'append (repeat (setq i (sslength (ssdel e (setq ss (ssget "_C" (trans ur 0 1) (trans ll 0 1) '((0 . "ARC,CIRCLE,ELLIPSE,*LINE"))) ) ) ) ) (setq l (cons (_groupbynum (vlax-invoke o 'intersectwith (vlax-ename->vla-object (ssname ss (setq i (1- i)))) acextendnone ) 3 ) l ) ) ) ) 1e-8 ) ) ) (if (not (vlax-curve-isClosed e)) (progn (or (equal (vlax-curve-getStartParam e) (vlax-curve-getParamatPoint e (car l)) 0.001) (setq l (cons (vlax-curve-getStartPoint e) l)) ) (or (equal (vlax-curve-getEndParam e) (vlax-curve-getParamatPoint e (last l)) 0.001) (setq l (append l (list (vlax-curve-getEndPoint e)))) ) ) (setq c l) ) (if (vlax-curve-isClosed e) (setq l (list (vlax-curve-getStartPoint e)) c l) (setq l (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))) ) ) (while (cadr l) (setq x (car l) y (cadr l) l (cdr l)) (setq m (vlax-curve-getPointatDist e (/ (+ (vlax-curve-getDistatPoint e y) (vlax-curve-getDistAtPoint e x)) 2.) ) ) [color=mediumturquoise];(setq d ; (abs ; (- (vlax-curve-getDistatPoint e y) (vlax-curve-getDistAtPoint e x)) ; ) ;(setq a ; (angle '(0. 0. 0.) ; (vlax-curve-getFirstDeriv e (vlax-curve-getParamatPoint e m)) ; ) ;(setq ta (_makereadable a)) ;(setq to (vla-AddText acspc (rtos d) (vlax-3D-point '(0. 0. 0.)) ts)) ;(vla-put-Alignment to acAlignmentMiddleCenter) ;(vla-put-TextAlignmentPoint to (vlax-3D-point (polar m (+ ta (/ pi 2.)) (* 1.1 ts)))) ;(vla-put-rotation to ta)[/color] [color=red](vla-AddDimAligned acspc (vlax-3D-point x) (vlax-3D-point y) (vlax-3D-point m))[/color] ) (if (vlax-curve-isclosed e) (progn (if (= 1 (length c)) (setq c (append c c))) (setq d (+ (setq d1 (vlax-curve-getDistatPoint e (car c))) (setq d2 (- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) (vlax-curve-getdistatpoint e (last c)))) ) ) (setq m (vlax-curve-getPointatDist e (if (< d1 (setq da (/ (+ d1 d2) 2.))) (setq da (- (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) (- da d1))) (setq da (- da d2)) ) ) ) (setq a (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv e (vlax-curve-getParamatPoint e m)) ) ) (setq ta (_makereadable a)) (setq to (vla-AddText acspc (rtos d) (vlax-3D-point '(0. 0. 0.)) ts)) (vla-put-Alignment to acAlignmentMiddleCenter) (vla-put-TextAlignmentPoint to (vlax-3D-point (polar m (+ ta (/ pi 2.)) (* 1.1 ts)))) (vla-put-rotation to ta) ) ) (_EndUndo acdoc) (princ) ) ;;------------------------------------------------------------;; (vl-load-com) (princ) (princ "\n:: IntLen.lsp | Version 1.4 | © Lee Mac 2011 www.lee-mac.com ::") (princ "\n:: Type \"IntLen\" or \"IntLenM\" to Invoke ::") (princ) ;;------------------------------------------------------------;; ;; End of File ;; ;;------------------------------------------------------------;; @Nguyenkaca : chịu khó đi hỏi hè. Cadtutor đòi hỏi bạn phải trình bày vấn đề một cách rõ ràng và cụ thể các trường hợp Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 15, 2011 Share Posted September 15, 2011 I hope LM don't mind . I've mark what changed Since the code header is still present and you have clearly marked your modifications, I'm happy. Hope the program is useful! Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 16, 2011 Author Share Posted September 16, 2011 I'm very very happy.I don't know what to say.The programe is useful. it helps me save a lot of time. Thanks you for all your help. Quote Link to comment Share on other sites More sharing options...
ketxu Posted September 16, 2011 Share Posted September 16, 2011 @Nguyenkaca : You just say Thanks alot to LeeMac His rountine is great already Mà quên, mình là người Việt nam mà Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 16, 2011 Author Share Posted September 16, 2011 The code is great.But i only select one object per time. Could you help me improve it. Let me can select all object. Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 16, 2011 Author Share Posted September 16, 2011 oh i want to say thank every body Quote Link to comment Share on other sites More sharing options...
nguyenkaca Posted September 16, 2011 Author Share Posted September 16, 2011 Ketxu, you are vietnamese? Quote Link to comment Share on other sites More sharing options...
ketxu Posted September 16, 2011 Share Posted September 16, 2011 The code is great.But i only select one object per time. Could you help me improve it. Let me can select all object. Don't u see prompt line to use Intlen and Use IntlenM ? Just use IntlenM to multi work oh i want to say thank every body Ketxu, you are vietnamese? Ừm, mình là người Việt nam ! 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.