transcad Posted February 21, 2012 Posted February 21, 2012 Good morning, I want to put a "gradation" on a curve (pline, spline, line) - see the attached drawing. And i have no idea how to do it, or if it's possible to do it. "Gradation" is always perpendicular on the curve.L1, L2, D - given values. Any idea? Measure? Vlax-curve-getPointAtDist? measure.dwg Quote
MSasu Posted February 21, 2012 Posted February 21, 2012 Regarding the programmatically approach, for sure it can be done. Along the function that you already proposed you will need to look also for the second derivative on insertion point in order to get the local tangent, and therefore the perpendicular on curve. Regards, Mircea Quote
transcad Posted February 21, 2012 Author Posted February 21, 2012 For the second derivative, which function to use? Quote
MSasu Posted February 21, 2012 Posted February 21, 2012 To list the second derivative on a curve at a given location should use vlax-curve-getSecondDeriv. I suggest you to check in help the vlax-curve-* functions family. Regards, Mircea Quote
Stefan BMR Posted February 21, 2012 Posted February 21, 2012 Sorry Mircea, I don't think the SecondDeriv is needed. This may help:: (setq tg (vlax-curve-getFirstDeriv entity param)) will give you the direction of the tangent to curve at param. So the perpendicular direction is (atan (cadr tg) (car tg)) + or - pi/2. Quote
MSasu Posted February 21, 2012 Posted February 21, 2012 Stefan, you are entirely right; I stand corrected. Sorry for inconvenience. Regards, Mircea Quote
Tharwat Posted February 21, 2012 Posted February 21, 2012 This may get you started , although that I did not get what you wanted specifically . Consider this just as an example . (defun c:TesT (/ ss p2 l d n) ;;; Tharwat 21. Feb. 2012 ;;; (if (and (setq ss (entsel "\n Select a Poly :")) (member (cdr (assoc 0 (entget (car ss)))) '("LINE" "SPLINE" "LWPOLYLINE" "POLYLINE") ) (setq p2 (1+ (fix (vlax-curve-getendparam (car ss))))) (setq l (vlax-curve-getdistatparam (car ss) (- p2 1))) (setq d (getdist "\n Specify the distance between points :")) (setq n d) ) (progn (entmake (list '(0 . "POINT") (cons 10 (vlax-curve-getpointatparam (car ss) 0)) ) ) (repeat (fix (/ l d)) (setq pt (vlax-curve-getpointatdist (car ss) d)) (entmake (list '(0 . "POINT") (cons 10 pt))) (setq d (+ n d)) ) ) (princ) ) (princ) ) Quote
transcad Posted February 23, 2012 Author Posted February 23, 2012 I want to compare 2 strings, what function to use? (= (cdr (assoc 0 (entget (car(entsel))))) "line") , i select a line and is not working... shoul i use equal, or eq...? Quote
Tharwat Posted February 23, 2012 Posted February 23, 2012 You should use it like this .. and = and eq functions are the same in this case . (eq (cdr (assoc 0 (entget (car(entsel))))) [color=blue][b]"LINE"[/b][/color]) Or this ... (= (cdr (assoc 0 (entget (car(entsel))))) [color=blue][b]"LINE"[/b][/color]) But all of these are not a good way of programming . because if you selected nothing , error would take a place . Quote
transcad Posted February 23, 2012 Author Posted February 23, 2012 how to determine start point and endpoint for a spline? Quote
Tharwat Posted February 23, 2012 Posted February 23, 2012 how to determine start point and endpoint for a spline? (if (and (setq sp (car (entsel "\n Select Spline :"))) (eq (cdr (assoc 0 (entget sp))) "SPLINE") ) (progn (princ (vlax-curve-getStartPoint sp)) (princ (vlax-curve-getendPoint sp)) ) (princ "\n Nothing selected or it is not a Spline ** ") ) Quote
transcad Posted February 23, 2012 Author Posted February 23, 2012 Thanks! I'm still sleeping... Quote
Tharwat Posted February 23, 2012 Posted February 23, 2012 Thanks! I'm still sleeping... You're welcome . Wake up and study the simple codes that we have just provided for you , and do not hesitate to ask for any clarification . Regards. Quote
transcad Posted February 23, 2012 Author Posted February 23, 2012 This is what i'm working on... sorry, not in English, but many of you will understand how is working... in fact are 3 codes in one... for different situation... many parts of the code is not necessary, is for my way of working... so i will show you guys my "masterpiece" ...still in working, not finished... Regards! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:taluz (/ Ldata ) ;;;;;;;;;;;;;;;;; UNDO COMPLET (defun *error* (msg) (and uFlag (vla-EndUndoMark aDoc)) (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))) (princ)) (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq uFlag (not (vla-StartUndoMark aDoc))) ;;;;;;;;;;;;;;;;;;;; (setq _LastEnt_ (entlast)) ;Selectie obiecte pt manipulare (setvar 'cmdecho 0) (defun rtd (r) (* 180.0(/ r pi))) (setq pol (car (entsel "\nSelecteaza Polilinia: ")) dist1 (getdist "\nDistanta intre borduri: ") l1 (getdist "\nLatime start: ") l2 (getdist "\nLatime sfarsit: ") lungpol (vlax-curve-getDistAtParam pol (vlax-curve-getEndParam pol)) ;lungime polilinie nrbord (fix (/ lungpol dist1)) dist (/ lungpol nrbord) dif (- l1 l2) ) (repeat (setq i nrbord) (setq Ldata (cons (list (setq pt (vlax-curve-getpointatdist pol (* (setq i (- i 1.0)) dist) ) ) (setq l (/ (+ l2 (* dif (/ i nrbord))))) (setq ang (+ (* 1.0 pi) (atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol pt) ) ) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol pt) ) ) ) ) ) ;;;;;;;;;;;;;;; (setq ptm (vlax-curve-getpointatdist pol (+ (* 0.5 dist) (* i dist)) ) ) (setq lm (/ l 2)) (setq angm (+ (* 1.0 pi) (atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol ptm) ) ) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol ptm) ) ) ) ) ) ) Ldata ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (not (tblsearch "BLOCK" "bordura")) (PROGN (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "bordura") (10 0 0 0) (70 . 0))) (entmakex (append (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "contur") (cons 100 "AcDbLine") (append '(10 0 0 0))(list 11 0 1 0)))) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq i nrbord) (repeat nrbord (command "-insert" "bordura" (car (nth (setq i (1- i)) Ldata));punct (cadr (nth i Ldata));scala x (cadr (nth i Ldata));scala y (rtd (caddr (nth i Ldata)));unghi ) ) (setq i (- nrbord 0)) (repeat i (command "-insert" "bordura" (car (cdddr(nth (setq i (1- i)) Ldata)));punct (cadr (cdddr(nth i Ldata)));scala x (cadr (cdddr(nth i Ldata)));scala y (rtd (caddr (cdddr(nth i Ldata))));unghi ) ) ;inserare primul bloc - la capatul poliliniei (setq tipentitate (cdr (assoc 0 (entget pol)))) (if (= (cdr (assoc 0 (entget pol))) "LINE") (setq p1 (cdr (assoc 11 (entget pol))))) ;;;;;;;;;;; (if (or(= (cdr (assoc 0 (entget pol))) "SPLINE") (= (cdr (assoc 0 (entget pol))) "LWPOLYLINE")) (setq p1 (vlax-curve-getEndPoint pol))) (setq par1 (vlax-curve-getParamAtPoint pol p1)) (setq ang1(atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol p1))) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol p1))))) (command "-insert" "bordura" p1 l1 "" (rtd(+ ang1 pi))) (setq Ltest Ldata) (*error* nil) ;pentru anulare completa - undo tot ce a fost desenat ;; Selectie obiecte pt manipulare (setq ss (ssadd)) (if (setq en (entnext _LastEnt_)) (while en (setq ss (ssadd en ss) en (entnext en) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "_.select" ss "") (princ) );end defun c: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:taluzr (/ Ldata ) ;;;;;;;;;;;;;;;;; UNDO COMPLET (defun *error* (msg) (and uFlag (vla-EndUndoMark aDoc)) (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))) (princ)) (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq uFlag (not (vla-StartUndoMark aDoc))) ;;;;;;;;;;;;;;;;;;;; (setq _LastEnt_ (entlast)) ;Selectie obiecte pt manipulare (setvar 'cmdecho 0) (defun rtd (r) (* 180.0(/ r pi))) (setq pol (car (entsel "\nSelecteaza Polilinia: ")) dist1 (getdist "\nDistanta intre borduri: ") l1 (getdist "\nLatime start: ") l2 (getdist "\nLatime sfarsit: ") lungpol (vlax-curve-getDistAtParam pol (vlax-curve-getEndParam pol)) ;lungime polilinie nrbord (fix (/ lungpol dist1)) dist (/ lungpol nrbord) dif (- l1 l2) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (repeat (setq i nrbord) (setq Ldata (cons (list (setq pt (vlax-curve-getpointatdist pol (* (setq i (- i 1.0)) dist) ) ) (setq l (/ (+ l2 (* dif (/ i nrbord))))) (setq ang (+ (* 1.0 pi) (atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol pt) ) ) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol pt) ) ) ) ) ) ;;;;;;;;;;;;;;; (setq ptm (vlax-curve-getpointatdist pol (+ (* 0.5 dist) (* i dist)) ) ) (setq lm (/ l 2)) (setq angm (+ (* 1.0 pi) (atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol ptm) ) ) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol ptm) ) ) ) ) ) ) Ldata ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (not (tblsearch "BLOCK" "bordurar")) (PROGN (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "bordurar") (10 0 0 0) (70 . 0))) (entmakex (append (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "contur") (cons 100 "AcDbLine") (append '(10 0 0 0))(list 11 0 -1 0)))) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))))) (setq i nrbord) (repeat nrbord (command "-insert" "bordurar" (car (nth (setq i (1- i)) Ldata));punct (cadr (nth i Ldata));scala x (cadr (nth i Ldata));scala y (rtd (caddr (nth i Ldata)));unghi ) ) (setq i (- nrbord 0)) (repeat i (command "-insert" "bordurar" (car (cdddr(nth (setq i (1- i)) Ldata)));punct (cadr (cdddr(nth i Ldata)));scala x (cadr (cdddr(nth i Ldata)));scala y (rtd (caddr (cdddr(nth i Ldata))));unghi ) ) ;inserare primul bloc - la capatul poliliniei (setq tipentitate (cdr (assoc 0 (entget pol)))) (if (= (cdr (assoc 0 (entget pol))) "LINE") (setq p1 (cdr (assoc 11 (entget pol))))) ;;;;;;;;;;; (if (or(= (cdr (assoc 0 (entget pol))) "SPLINE") (= (cdr (assoc 0 (entget pol))) "LWPOLYLINE")) (setq p1 (vlax-curve-getEndPoint pol))) (setq par1 (vlax-curve-getParamAtPoint pol p1)) (setq ang1(atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol p1))) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol p1))))) (command "-insert" "bordurar" p1 l1 "" (rtd(+ ang1 pi))) (setq Ltest Ldata) (princ) (*error* nil) ;pentru anulare completa - undo tot ce a fost desenat ;; Selectie obiecte pt manipulare (setq ss (ssadd)) (if (setq en (entnext _LastEnt_)) (while en (setq ss (ssadd en ss) en (entnext en) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "_.select" ss "") );end defun c: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:bordura (/ Ldata ) ;;;;;;;;;;;;;;;;; UNDO COMPLET (defun *error* (msg) (and uFlag (vla-EndUndoMark aDoc)) (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))) (princ)) (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq uFlag (not (vla-StartUndoMark aDoc))) ;;;;;;;;;;;;;;;;;;;; (setq _LastEnt_ (entlast)) ;Selectie obiecte pt manipulare (setvar 'cmdecho 0) (defun rtd (r) (* 180.0(/ r pi))) (setq pol (car (entsel "\nSelecteaza Polilinia: ")) dist1 (getdist "\nDistanta intre borduri: ") l1 (getdist "\nLatime start: ") l2 (getdist "\nLatime sfarsit: ") lungpol (vlax-curve-getDistAtParam pol (vlax-curve-getEndParam pol)) ;lungime polilinie nrbord (fix (/ lungpol dist1)) dist (/ lungpol nrbord) dif (- l1 l2) ) ;;;;;;;;;;;;;;;;;;;;; (repeat (setq i nrbord) (setq Ldata (cons (list (setq pt (vlax-curve-getpointatdist pol (* (setq i (- i 1.0)) dist) ) ) (setq l (/ (+ l2 (* dif (/ i nrbord))))) (setq ang (+ (* 1.0 pi) (atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol pt) ) ) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol pt) ) ) ) ) ) ) Ldata ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (not (tblsearch "BLOCK" "bordura")) (PROGN (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbBlockReference") (2 . "bordura") (10 0 0 0) (70 . 0))) (entmakex (append (list (cons 0 "LINE") (cons 100 "AcDbEntity") (cons 67 0) (cons 8 "contur") (cons 100 "AcDbLine") (append '(10 0 0 0))(list 11 0 1 0)))) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0"))))) (setq i nrbord) (repeat nrbord (command "-insert" "bordura" (car (nth (setq i (1- i)) Ldata));punct (cadr (nth i Ldata));scala x (cadr (nth i Ldata));scala y (rtd (caddr (nth i Ldata)));unghi ) ) ;inserare primul bloc - la capatul poliliniei (setq tipentitate (cdr (assoc 0 (entget pol)))) (if (= (cdr (assoc 0 (entget pol))) "LINE") (setq p1 (cdr (assoc 11 (entget pol))))) ;;;;;;;;;;; (if (or(= (cdr (assoc 0 (entget pol))) "SPLINE") (= (cdr (assoc 0 (entget pol))) "LWPOLYLINE")) (setq p1 (vlax-curve-getEndPoint pol))) (setq par1 (vlax-curve-getParamAtPoint pol p1)) (setq ang1(atan (cadr (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol p1))) (car (vlax-curve-getFirstDeriv pol (vlax-curve-getParamAtPoint pol p1))))) (command "-insert" "bordura" p1 l1 "" (rtd(+ ang1 pi))) (setq Ltest Ldata) (princ) (*error* nil) ;pentru anulare completa - undo tot ce a fost desenat ;; Selectie obiecte pt manipulare (setq ss (ssadd)) (if (setq en (entnext _LastEnt_)) (while en (setq ss (ssadd en ss) en (entnext en) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (command "_.select" ss "") );end defun c: Quote
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.