hctub Posted December 7, 2010 Share Posted December 7, 2010 (edited) Guys Im a newbie in autolisp can someone help me to edit this code. I want to change the output from polyline to spline and labeled as per 50 meters. (defun timeini () (setq s (getvar "DATE")) (setq seconds (* 86400.0 (- s (fix s)))) ) (defun timeend () (setq s1 (getvar "DATE")) (setq seconds1 (* 86400.0 (- s1 (fix s1)))) (setq seconds2 (fix (- seconds1 seconds))) (princ (strcat "\nTime : " (itoa seconds2) " seconds" ) ) ) (defun inivar () (setq cmd_ini (getvar "cmdecho") fla_ini (getvar "flatland") osm_ini (getvar "osmode") ort_ini (getvar "orthomode") plt_ini (getvar "plinetype") aup_ini (getvar "auprec") uni_ini (getvar "unitmode") lun_ini (getvar "lunits") diz_ini (getvar "dimzin") edg_ini (getvar "edgemode") ) (setvar "CMDECHO" 0) (setvar "FLATLAND" 0) (setvar "OSMODE" 0) (setvar "ORTHOMODE" 0) (setvar "PLINETYPE" 2) (setvar "AUPREC" 0) (setvar "UNITMODE" 1) (setvar "LUNITS" 2) (setvar "DIMZIN" 0) (setvar "EDGEMODE" 1) ) (defun recvar () (setvar "CMDECHO" cmd_ini) (setvar "FLATLAND" fla_ini) (setvar "OSMODE" osm_ini) (setvar "ORTHOMODE" ort_ini) (setvar "PLINETYPE" plt_ini) (setvar "AUPREC" aup_ini) (setvar "UNITMODE" uni_ini) (setvar "LUNITS" lun_ini) (setvar "DIMZIN" diz_ini) (setvar "EDGEMODE" edg_ini) ) (defun getlayname () (setq contourstest nil) (setq layername (getstring "\nPlease enter the layer name of the contours: " ) ) (setq contourstest (ssget "_x" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "lwpolyline") (cons 8 layername) (cons -4 "AND>") (cons -4 "<AND") (cons 0 "polyline") (cons 8 layername) (cons -4 "AND>") (cons -4 "<AND") (cons 0 "line") (cons 8 layername) (cons -4 "AND>") (cons -4 "<AND") (cons 0 "spline") (cons 8 layername) (cons -4 "AND>") (cons -4 "OR>") ) ) ) (while (= contourstest nil) (princ "\nNo contours selected...") (setq layername (getstring "\nPlease enter the layer name of the contours: " ) ) (setq contourstest (ssget "_x" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "lwpolyline") (cons 8 layername) (cons -4 "AND>") (cons -4 "<AND") (cons 0 "polyline") (cons 8 layername) (cons -4 "AND>") (cons -4 "<AND") (cons 0 "line") (cons 8 layername) (cons -4 "AND>") (cons -4 "<AND") (cons 0 "spline") (cons 8 layername) (cons -4 "AND>") (cons -4 "OR>") ) ) ) ) ) (defun activexsupport () (vl-load-com) (setq *modelspace* (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) ) ) (defun esttexto () (vl-cmdf "._style" "PMSF-TEXT" "romans" 2.50 0.80 0 "n" "n" "n") ) (defun getha () ;; this entity must be a lwpolyline (activexsupport) (setq ha (entsel "\nSelect the Horizontal alignment: ") ) (while (= ha nil) (progn (princ "\nNothing selected...") (setq ha (entsel "\nSelect the Horizontal alignment: ") ) ) ) (setq ha-type (cdr (assoc 0 (entget (car ha))))) (if (not (equal ha-type "LWPOLYLINE")) (progn (setq ha nil) (princ "\n***Horizontal Alignment must be a LWPolyline***") ) ) (while (= ha nil) (progn (princ "\nNothing selected...") (setq ha (entsel "\nSelect the Horizontal alignment: ") ) (setq ha-type (cdr (assoc 0 (entget (car ha))))) (if (not (equal ha-type "LWPOLYLINE")) (progn (setq ha nil) (princ "\n***Horizontal Alignment must be a LWPolyline***") ) ) ) ) (setq ha-ename (entget (car ha))) (setq ha-ename (cdr (assoc -1 ha-ename))) (setq ha-object (vlax-ename->vla-object ha-ename)) (vl-cmdf "._text" (vlax-curve-getstartpoint ha-object) "0" "A" ) (vl-cmdf "._text" (vlax-curve-getendpoint ha-object) "0" "B" ) ) (defun getexaggeration () (initget 2) (setq ve (getreal "\nEnter the vertical exaggeration <1>: ")) (if (= ve nil) (setq ve 1) ) ) (defun listptintersect () (setq listaxy nil) (setq hazvalue (caddr (vlax-curve-getStartPoint ha-object))) (setq curvas contourstest) (setq ncurvas (sslength curvas)) (setq listaxy nil) (setq counter 0) (while (< counter ncurvas) (progn (setq cnivel-ename (ssname curvas counter)) (setq cnivel-object (vlax-ename->vla-object cnivel-ename)) (setq cnivelzvalue (caddr (vlax-curve-getStartPoint cnivel-object)) ) (setq ha-ENTITY (subst (cons 38 cnivelzvalue) (assoc 38 (entget (car ha))) (entget (car ha)) ) ) (entmod ha-ENTITY) (setq intersectpt (vlax-variant-value (vlax-invoke-method ha-object "IntersectWith" cnivel-object acExtendNone ) ) ) (setq test nil) (setq test (vl-catch-all-apply 'vlax-safearray->list (list intersectpt) ) ) (setq error (vl-catch-all-error-p test)) (if (/= error t) (progn (setq intersectpt (vlax-safearray->list intersectpt)) (setq interlength (length intersectpt)) (if (> interlength 3) (progn (setq dividelength (/ interlength 3)) (setq count 0) (while (< count interlength) (progn (setq newpt (list (nth count intersectpt) (nth (+ count 1) intersectpt) (nth (+ count 2) intersectpt) ) ) (setq x (vlax-curve-getdistatPoint ha-ename newpt)) (setq z (caddr intersectpt)) (setq xy (list x (* z ve))) (setq listaxy (append listaxy (list xy)) ) (setq count (+ count 3)) ) ) ) (progn (setq x (vlax-curve-getdistatPoint ha-ename intersectpt)) (setq z (caddr intersectpt)) (setq xy (list x (* z ve))) (setq listaxy (append listaxy (list xy)) ) ) ) (setq ha-ENTITY (subst (cons 38 hazvalue) (assoc 38 (entget (car ha))) (entget (car ha)) ) ) (entmod ha-ENTITY) ) ) (setq counter (1+ counter)) ) ) (setq listaxy (vl-sort listaxy (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) ) ) (setq startdist (vlax-curve-getdistatPoint ha-ename (vlax-curve-getstartpoint ha-ename) ) enddist (vlax-curve-getdistatPoint ha-ename (vlax-curve-getendpoint ha-ename) ) ) (setq pt1 (car (car listaxy)) pt2 (car (last listaxy)) ) (if (/= startdist pt1) (progn (setq x startdist) (setq y (+ (* (/ (- (cadr (car listaxy)) (cadr (cadr listaxy))) (- (car (cadr listaxy)) (car (car listaxy))) ) (- (car (car listaxy)) startdist) ) (cadr (car listaxy)) ) ) (setq xy (list x y)) (setq listaxy (append listaxy (list xy)) ) (setq listaxy (vl-sort listaxy (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) ) ) ) ) (if (/= enddist pt1) (progn (setq pos (1- (length listaxy))) (setq x enddist) (setq y (+ (* (/ (- (cadr (nth pos listaxy)) (cadr (nth (1- pos) listaxy)) ) (- (car (nth pos listaxy)) (car (nth (1- pos) listaxy))) ) (- enddist (car (nth pos listaxy))) ) (cadr (nth pos listaxy)) ) ) (setq xy (list x y)) (setq listaxy (append listaxy (list xy)) ) (setq listaxy (vl-sort listaxy (function (lambda (e1 e2) (< (car e1) (car e2)) ) ) ) ) ) ) ) (defun createprofile () (setq variante-listaxy (apply 'append listaxy)) (setq arraySpace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length variante-listaxy) 1) ) ) ) (setq variante-listaxy (vlax-safearray-fill arraySpace variante-listaxy) ) (vlax-make-variant variante-listaxy) (setq spline (vla-addLightweightPolyline *ModelSpace* variante-listaxy ) ) (vl-cmdf "._text" (vlax-curve-getstartpoint spline) "0" "A" ) (vl-cmdf "._text" (vlax-curve-getendpoint spline) "0" "B" ) ) (defun annotate () (setq xini (car (vlax-curve-getstartpoint pline)) xend (car (vlax-curve-getendpoint pline)) y (* (fix (/ (cadr (car (vl-sort listaxy (function (lambda (e1 e2) (< (cadr e1) (cadr e2)) ) ) ) ) ) ve ) ) ve ) ) ;;end setq (if (< y 0) (setq y (- y (* 1 ve))) ) (setq var-xyini (apply 'append (list (list xini y 0)))) (setq var-xyend (apply 'append (list (list xend y 0)))) (createline) (setq yref (strcat "REFERENCE: " (rtos (/ y ve) 2 2))) (setq ptloc (list (- xini 30.0) y)) (vl-cmdf "._text" ptloc "0" yref) (setq lengthlistaxy (length listaxy)) (setq count 0) (while (< count lengthlistaxy) (progn (setq var-xyini (apply 'append (list (list (car (nth count listaxy)) (cadr (nth count listaxy)) 0 ) ) ) ) (setq var-xyend (apply 'append (list (list (car (nth count listaxy)) y 0)) ) ) (createline) (setq ytext (rtos (/ (cadr (nth count listaxy)) ve) 2 2)) (setq xpt (car (nth count listaxy))) (setq xtext (rtos xpt 2 2));;CB 11/24/09 (setq ptloc (list xpt (- y 10.0))) (setq ptloc2 (list xpt (- y 30.0)));;CB 11/24/09 (vl-cmdf "._text" ptloc "90" ytext) (vl-cmdf "._text" ptloc2 "90" xtext);;CB 11/24/09 (setq count (1+ count)) ) ) ) (defun createline () (setq arraySpace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length var-xyini) 1) ) ) ) (setq var-xyini (vlax-safearray-fill arraySpace var-xyini) ) (vlax-make-variant var-xyini) (setq arraySpace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length var-xyend) 1) ) ) ) (setq var-xyend (vlax-safearray-fill arraySpace var-xyend) ) (vlax-make-variant var-xyend) (setq line (vla-addline *ModelSpace* var-xyini var-xyend ) ) ) ;;----------------------------------------------------- ;;print chainage and elevs to drawing CAB 11/20/09 (defun print_table () (initget 1) (setq TabInsPt (getpoint "\nPick upper left table location: ")) (setq Tab_lbl1 "%HAINAGE") (command "._text" TabInsPt 0.0 Tab_lbl1) (setq TxtLen (caadr (textbox (entget (entlast))))) (setq Pt2 (list (+ (car TabInsPt) txtlen (cdr (assoc 40 (entget (entlast))))) (cadr TabInsPt))) (foreach ch_val listaxy (setq sta (rtos (car ch_val) 2 2)) (command "._text" "" sta) ) (command "._text" Pt2 0.0 "%LEVATION") (foreach ch_val listaxy (setq elev (rtos (cadr ch_val) 2 2)) (command "._text" "" elev) ) ) ;;-------------------------------------------------- (defun c:qp () (timeini) (inivar) (getlayname) (esttexto) (getha) (getexaggeration) (listptintersect) (createprofile) (annotate) ;;;(print_table);;11/20/09 (vl-cmdf "._zoom" (vlax-curve-getstartpoint pline) (vlax-curve-getendpoint pline) ) (recvar) (timeend) (princ) ) Edited December 7, 2010 by Tiger added codetags 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.