anindya Posted September 25, 2014 Share Posted September 25, 2014 can i get the desired result ??? i have attached a sample drawing.is it possible by lisp or vba?????? need help 200000.dwg Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 26, 2014 Share Posted September 26, 2014 Pretty sure this question was asked not long ago try searching here using offset. It can be done in CIV3d else it will be a lisp chainage and offset. Quote Link to comment Share on other sites More sharing options...
anindya Posted September 26, 2014 Author Share Posted September 26, 2014 can you provide me the lisp me using auto cad 2007.pls give me that one. Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted September 26, 2014 Share Posted September 26, 2014 (edited) Hi, alignment should be 2D (plan view) right? not fully tested, must be lots of bugs... (vlax-curve* iteration default in 3D, it also never gets a secant angle at polyline vertex ) please try first. command: STALBL (if (not *ch*) (setq *ch* 0.0) ) ;_ end of if (defun c:STALBL (/ *error* cl e obj ss l cor ch flatz) [color="#696969"]http://www.cadtutor.net/forum/showthread.php?88888-station-and-distance-of-points[/color] ;hanhphuc 27/09/14 (defun *error* (msg) (if (not (wcmatch (strcase msg) "*CANCEL*,*EXIT*,*UNKNOWN*")) ;v1.0 (princ (strcat "\nError: " msg)) ) ;_ end of if (princ) ) ;_ end of defun (setq ch (getreal (strcat "\nStart station CH <" (rtos *ch* 2 3) "> ? : ")) *ch* (if ch ch *ch* ) ;_ end of if flatz '((p) (reverse (cons 0.0 (cdr (reverse p))))) ) ;_ end of setq (if (and (setq cl (car (entsel "\nPick horizontal alignment.."))); <--- LWpolyline (setq ss (ssget "_:L" '((0 . "POINT,LINE,CIRCLE,ARC,LWPOLYLINE")))); [color="red"]<--- this can be modified[/color] ) ;_ end of and (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (mapcar ''((x) (entmakex (mapcar 'cons '(0 100 100 1 10 40 8 7 71) (list "MTEXT" "AcDbEntity" "AcDbMText" (strcat "STA : " ([color="red"][b]rtosta[/b][/color] (car x) 2 3) "\\POFFSET: " (rtos (abs (cadr x)) 2 3) (if (minusp (cadr x)) " L" " R" ) ;_ end of if ) ;_ end of strcat (caddr x) (getvar "textsize") "STALBL" (getvar "textstyle") 5 ) ;_ end of list ) ;_ end of mapcar ) ;_ end of entmake ) ;_ end of lambda ((lambda (lst vo sta / ang pa dir ) (vl-remove nil (mapcar ''((p / d l) (setq p (if (> (length p) 2) (flatz p) p ) ;_ end of if d (vlax-curve-getDistAtPoint vo (setq pa (flatz (vlax-curve-getClosestPointTo vo p nil)))) ) ;_ end of setq (if (and (> d 0.) (< d (vla-get-length vo))) (progn (setq ang (angle (vlax-curve-getFirstDeriv vo (vlax-curve-getParamAtPoint vo pa)) '(0.0 0.0 0.0)) dir (if (<= ang (* pi 1.5)) (- (* pi 1.5) ang) (- (* pi 3.5) ang) ) ;_ end of if ) ;_ end of setq (list (+ sta d) (- (* (- (car p) (car pa)) (cos dir)) (* (- (cadr p) (cadr pa)) (sin dir))) p ) ;_ end of list ) ;_ end of progn ) ;_ end of if ) lst ) ;_ end of mapcar ) ;_ end of vl-remove ) (progn (foreach p '("Coordinates" "EndPoint" "StartPoint" "InsertionPoint" "Center" "TextPosition" "FitPoints") ; <-- spine line (setq obj (vlax-ename->vla-object e)) (if (vlax-property-available-p obj p) (setq l (cons p l)) ) ;_ end of if ) ;_ end of foreach (setq cor (mapcar ''((p) (vlax-get obj p)) l)) (eval (cons 'cond (reverse (vl-list* '(t cor) (mapcar ''((a b) (list (list '= (cdr (assoc 0 (entget e))) a) (cons 'quote (list ('((lst len opt / ls l i) (setq i 1 l '() len (if opt (/ (length lst) len) len ) ) (while lst (setq l (append l (list (car lst)))) (if (zerop (rem i len)) (setq ls (cons l ls) l nil ) ; append ) (setq i (1+ i) lst (cdr lst) ) ) ;_ end of foreach (if l (append (reverse ls) (list l)) (reverse ls) ) ;_ end of if ) (car cor) b nil ) ) ) ) ) '("LWPOLYLINE" "POLYLINE" "LEADER" "SPLINE") '(2 3 3 3) ) ;_ end of mapcar ) ;_ end of cons ) ;_ end of reverse ) ;_ end of cons ) ;_ end of eval ) ;_ end of progn (vlax-ename->vla-object cl) *ch* ) ) ;_ end of mapcar ) ;_ end of foreach ) ;_ end of if (princ) ) ;_ end of defun (princ "\nhanhphuc 2014. Label Station Offset. Command: STALBL") (grtext -1 "STALBL.lsp v1.0 hanhphuc") (princ) This STA string format courtesy of ymg ;;http://www.theswamp.org/index.php?topic=45311.0 ;; rtosta by ymg September 2013 ; ;; ; ;; Arguments: sta Real number to format as a Station ; ;; unit 1 for Imperials, ; ;; 2 for Metrics. ; ;; prec Integer for number of decimals ; ;; ; ;; Examples: (rtosta 0 1 0) -> "0+00" (rtosta 1328.325 1 2) -> "13+28.33" ; ;; (rtosta 0 2 0) -> "0+000" (rtosta 1328.325 2 2) -> "1+328.33" ; ;; ; ;; If sta is negative, format is as follow: ; ;; (rtosta -1328.325 1 2) -> "13-28.33" ; ;; (rtosta -1328.325 2 2) -> "1-328.33" ; ;; ; (defun rtosta (sta unit prec / str a b dz) (setq dz (getvar 'dimzin)) (setvar 'dimzin 0) (setq str (rtos (abs sta) 2 prec)) (setvar 'dimzin dz) (while (< (strlen str) (if (= prec 0) (+ unit 2) (+ prec (+ unit 3)) ) ;_ end of if ) ;_ end of < (setq str (strcat "0" str)) ) ;_ end of while (setq a (if (= prec 0) (- (strlen str) unit) (- (strlen str) prec (+ unit 1)) ) ;_ end of if b (substr str 1 (- a 1)) a (substr str a) ) ;_ end of setq (strcat b (if (minusp sta) "-" "+" ) ;_ end of if a ) ;_ end of strcat ) ;_ end of defun Edited September 27, 2014 by hanhphuc add link, variable ret N/A, reply msg, ARC Quote Link to comment Share on other sites More sharing options...
anindya Posted September 28, 2014 Author Share Posted September 28, 2014 thanks too much hanhphuc sir.it is working great....can it modify little bit so that it will show the x and y coordinates of each points along with the offset distance and chainage...? Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted September 28, 2014 Share Posted September 28, 2014 (edited) thanks too much hanhphuc sir.it is working great....can it modify little bit so that it will show the x and y coordinates of each points along with the offset distance and chainage...? you are welcome, credit to ymg. i encourage you too learn too, so add this inside the previous code... Try to locate & add / modify in red.. last end of defun grey is existing code. This option for add coordinates if you wish [color="#696969"](defun c:STALBL (/ *error* cl e obj ss l cor ch flatz) ... ... ...[/color] [color="red"];USER Options (setq On/Off t); t=ON, ;(setq On/Off nil) = nil=OFF (if (and On/Off (ssget "X" '((0 . "MTEXT")(8 . "STALBL")))) (vlax-for tx (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))) (setq str (vla-get-textstring tx)) (vla-put-textstring tx (strcat str (if (wcmatch str "*X*,*Y*,*Z*") "" (apply 'strcat (mapcar '(lambda (a b) (strcat a (rtos b 2 3))) '("\\PX= " "\\PY= " "\\PZ= ") (trans (vlax-get tx 'Insertionpoint) 0 1) ; thanx Tharwat ) ;_ end of mapcar ) ;v1.1 ) ) ;_ end of strcat ) ;_ end of vla-put-textstring ) ;_ end of vlax-for ) ;_ end of if[/color] [color="#696969"] (princ) ) ;_ end of defun (princ "\nhanhphuc 2014. Label Station Offset. Command: STALBL") (grtext -1 "STALBL.lsp v1.0 hanhphuc") (princ)[/color] Don't you think a bit messy if too much text with XYZ? Edited October 3, 2014 by hanhphuc Options added for coordinates Quote Link to comment Share on other sites More sharing options...
anindya Posted September 28, 2014 Author Share Posted September 28, 2014 the x,y,z coordinates should be placed after every offset and chainages like first chainage say 0+500 then offset say 100L then X=xxxxxxxx then Y=xxxxxx then Z=xxxxxxx then i will try to export all from drawing to excel.how will it possible? Quote Link to comment Share on other sites More sharing options...
anindya Posted September 29, 2014 Author Share Posted September 29, 2014 hanhphuc sir,,, WHERE TO PUT THAT CODE TO GET THE COORDINATES OF EVERY POINTS ....I CANT UNDERSTAND.PLS HELP ME . Quote Link to comment Share on other sites More sharing options...
anindya Posted October 1, 2014 Author Share Posted October 1, 2014 I have attached sample drawing for your observation.pls help me (STALBL)FOR OFFSET CHAINAGE (2).LSP (STALBL)FOR OFFSET CHAINAGE111.LSP NEED HELP 40000.dwg Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted October 1, 2014 Share Posted October 1, 2014 hi anindya, please don't make duplicated/similar post as the previous thread is still visible, this is confusing ? In post#6 which i have updated how to put additional red codes in existing lisp just copy & paste.. Quote Link to comment Share on other sites More sharing options...
SLW210 Posted October 1, 2014 Share Posted October 1, 2014 I merged your two threads. Please do not create more than one thread per question, as mentioned, it creates confusion. Quote Link to comment Share on other sites More sharing options...
anindya Posted October 2, 2014 Author Share Posted October 2, 2014 Respected sir where to paste that red portion?????????????....i am novice in case of lisp.PLS give me the full lisp with modification...plsssss. Quote Link to comment Share on other sites More sharing options...
hanhphuc Posted October 3, 2014 Share Posted October 3, 2014 hi anindya, regardless knowing the code, LISP is just normal ascii characters. you just need copy the red line locate the existing code then paste it. This update is Optional: here Quote Link to comment Share on other sites More sharing options...
anindya Posted October 3, 2014 Author Share Posted October 3, 2014 thanks sir... it is solved...thanks for your help. 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.