Tomislav Posted July 31, 2020 Share Posted July 31, 2020 (defun c:lpsv (/ f a numt doc_path txt decimals name cmd alignment startstation) (defun *error* (msg) (if (or (= msg "quit / exit abort") (= msg "bad argument type: lentityp nil") (= msg "bad argument type: numberp: nil") ) ;_ or (princ "") (princ msg) ) ;_ if (if f (close f) ) ;_ if (command-s "ucs" "") (setvar 'CELWEIGHT oldLweight) (setvar 'OSMODE oldOsmode) (setvar 'DIMZIN oldDimzin) (setvar 'CMDECHO oldCmdecho) ) ;_ defun (setq pntal nil loop nil main nil base nil base_height nil station nil pnt nil some_pnt nil pntsort nil pnttrans_w nil ) ;_ setq (setq acadObj (vlax-get-acad-object) doc (vla-get-ActiveDocument acadObj) mSpace (vla-get-ModelSpace doc) ) ;_ setq (setq oldCmdecho (getvar 'CMDECHO)) (setq oldDimzin (getvar 'DIMZIN)) (setq oldOsmode (getvar 'OSMODE)) (setq oldLweight (getvar 'CELWEIGHT)) (setvar 'CMDECHO 0) (setvar 'DIMZIN 1) (vl-load-com) (setq txt "") (initget 0 "A R") (or (setq coord_type (getkword "\nDo you wish to list absolut coordinates as .txt or relative to alignment as .csv [ <Absolut> / Relative ] " ) ;_ getkword ) ;_ setq (setq coord_type "A") ) ;_ or (if (= coord_type "A") (progn (initget 0 "N W") (or (setq name (getkword "\nDo you wish to list coords with name or without [ <Name> / Without ] " ) ;_ getkword ) ;_ setq (setq name "N") ) ;_ or ) ;_ progn ) ;_ if (initget 0 "0 1 2 3 4") (or (setq decimals (getkword "\nEnter number of decimals [ 0/1/2/3/4 ] <3> : ")) (setq decimals "3") ) ;_ or (setq decimals (atoi decimals)) (setq doc_path (getvar 'DWGPREFIX)) (setq doc_path (vl-string-translate "/" "\\" doc_path)) (if (= coord_type "R") (setq f (open (getfiled "Csv File" doc_path "csv" 5) "a")) (progn (setq f (open (getfiled "Text File" doc_path "txt" 5) "a")) (setq alignment (vlax-ename->vla-object (ssname (lm:ssget "\nSelect an alignment : " '(":S" ((0 . "LINE,LWPOLYLINE,POLYLINE,AECC_ALIGNMENT"))) ) ;_ lm:ssget 0 ) ;_ ssname ) ;_ vlax-ename->vla-object ) ;_ setq ;;; podaci za alignment (if (= (getvar 'USERR1) 0) (progn (or (setq startstation (getreal "\nEnter alignment starting station <0.0> : ")) (setq startstation 0.0) ) ;_ or (setvar 'USERR1 startstation) ) ;_ progn (progn (princ "\nEnter alignment starting station <") (princ (getvar 'USERR1)) (princ "> : ") (if (setq startstation (getreal)) (setvar 'USERR1 startstation) (setq startstation (getvar 'USERR1)) ) ;_ if ) ;_ progn ) ;_ if ) ;_ progn ) ;_ if (setvar 'OSMODE 33) ;;; podaci sa profila (setq main T) (setq loop T) (while (setq station (getreal "\nEnter station : ")) ;;;LOOP BACK HERE (if (> 0 (- station startstation)) (progn (alert "Station must be larger than alignment starting station!!!") (exit) ) ;_ progn ) ;_ if (setq base (getpoint "\nPick base point on section view: ") base_height (getreal "\nEnter lowest height : ") ) ;_ setq (while loop ;;; racuna srediste ucs-a na osi kao i prethodnu i slijedecu tocku (if (= coord_type "A") (progn (setq pnt_ucs_station (vlax-curve-getPointAtDist alignment (- station startstation))) (setq pnt_ucs_station_prev (vlax-curve-getPointAtDist alignment (- station startstation 0.001) ) ;_ vlax-curve-getPointAtDist ) ;_ setq (setq pnt_ucs_station_next (vlax-curve-getPointAtDist alignment (+ (- station startstation) 0.001) ) ;_ vlax-curve-getPointAtDist ) ;_ setq ;;; izabiranje tocaka (if (= name "N") ;;; SA IMENOM TOCKE (progn (if (wcmatch (cdr (assoc 0 (setq numt (ENTGET (CAR (ENTSEL "\nSelect point number: ")))) ) ;_ assoc ) ;_ cdr "ATTRIB,MTEXT,TEXT" ) ;_ wcmatch (progn (vl-cmdf "ucs" base "") (vl-cmdf "ucs" (list 0 (* base_height -1)) "") (vl-cmdf "ucs" "x" "-90") (setvar "osmode" 9) (setq pnt (getpoint (list 0.0 0.0 base_height) "\nSelect point : ")) (setvar 'OSMODE 0) (vl-cmdf "ucs" "") (if (/= station startstation) (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_prev "90") (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_next "-90") ) ;_ if (if (= (cdr (assoc 0 numt)) "MTEXT") (progn (GetTextFromMText numt) (princ txt f) (princ "\n") ) ;_ progn (princ (cdr (assoc 1 numt)) f) ) ;_ if (princ "," f) (princ (rtos (car a) 2 decimals) f) (princ "," f) (princ (rtos (cadr a) 2 decimals) f) (princ "," f) (princ (rtos (caddr a) 2 decimals) f) (princ "," f) (princ "\n" f) ) ;_ progn (if f (close f) ) ;_ if ) ;_ if ) ;_ progn ) ;_ if (if (= name "W") ;;; BEZ IMENA TOCKE (progn (vl-cmdf "ucs" base "") (vl-cmdf "ucs" (list 0 (* base_height -1)) "") (vl-cmdf "ucs" "x" "-90") (setvar "osmode" 9) (if (not (setq pnt (getpoint (list 0.0 0.0 base_height) "\nSelect point : "))) (setq loop nil) ) ;_ if (setvar 'OSMODE 0) (vl-cmdf "ucs" "") (if (/= station startstation) (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_prev "90") (GetPointFromUserUCStoWCS pnt pnt_ucs_station pnt_ucs_station_next "-90") ) ;_ if (princ (rtos (car a) 2 decimals) f) (princ "," f) (princ (rtos (cadr a) 2 decimals) f) (princ "," f) (princ (rtos (caddr a) 2 decimals) f) (princ "," f) (princ "\n" f) ) ;_ progn ) ;_ if ) ;_ progn (if (= coord_type "R") (progn (vl-cmdf "ucs" base "") (vl-cmdf "ucs" (list 0 (* base_height -1)) "") (vl-cmdf "ucs" "x" "-90") (setvar "osmode" 9) (setq pnt (getpoint (list 0.0 0.0 base_height) "\nSelect point : ")) (princ (strcat (rtos station 2 2) ";" (rtos (car pnt) 2 decimals) "\n" ";" (rtos (caddr pnt) 2 decimals) "\n" ) ;_ strcat f ) ;_ princ (vl-cmdf "ucs" "") ) ;_ progn ) ;_ if ) ;_ while ) ;_ while loop ) ;while main ;;; (if f ;;; (close f) ;;; ) ;_ if ) ;_ defun (princ "\nList points from section view..\n...Type LPSV to initiate..." ) ;_ princ ;********************************************* (defun GetTextFromMText (numt / posto_pos ima) (setq txt (cdr (assoc 1 numt))) ;vadim tekst (setq txt (vl-string-right-trim " } " txt)) ;oduzimam desnu } i razmak (setq txt (substr txt (+ (vl-string-search ";" txt) 2))) ;oduzimam sve do prvog ; (if (= (vl-string-search ";" txt (- (strlen txt) 1)) (- (strlen txt) 1)) ; ako je ; na kraju (setq txt (vl-string-right-trim "; " txt)) ;oduzimam desno sve do ; ) ;_ if (if (= (vl-string-search "{" txt) 0) ;ako je ostala na prvom mjestu { vadim sve od (setq txt (substr txt (vl-string-search ";" txt))) ; prvog ; do kraja ) ;_ if (if (> (vl-string-search "{" txt) 0) ;ako je ostala negdje { vadim sve od nje do ; (setq txt (strcat (substr txt 1 (vl-string-search "{" txt)) ; i spajam s ostalim (substr txt (+ (vl-string-search ";" txt) 2)) ) ;_ strcat ) ;_ setq ) ;_ if (setq txt (vl-string-subst "" "\\S" txt)) (setq ima T) (while ima (if (> (setq posto_pos (vl-string-search "%%" txt)) 0) (setq txt (strcat (substr txt 1 posto_pos) (substr txt (+ posto_pos 4)))) (setq ima nil) ) ;_ if ) ;_ while ) ;_ defun (DEFUN GetPointFromUserUCStoWCS (pnt ucs_base_pnt ucs_direction_pnt ucs_angle / pnttrans_w) (vl-cmdf "ucs" "3p" ucs_base_pnt ucs_direction_pnt "") (vl-cmdf "ucs" "z" ucs_angle) (setq pnttrans_w (trans pnt 1 0)) (vl-cmdf "ucs" "") (setq a (list (car pnttrans_w) (cadr pnttrans_w) (caddr pnttrans_w))) ) ;_ DEFUN ;************************************************** (DEFUN lm:ssget (MSG PARAMS / SEL) ;thanx Lee (PRINC MSG) (SETVAR 'NOMUTT 1) (SETQ SEL (VL-CATCH-ALL-APPLY 'SSGET PARAMS)) (SETVAR 'NOMUTT 0) (IF (NOT (VL-CATCH-ALL-ERROR-P SEL)) SEL ) ;_ _ IF ) ;_ _ DEFUN ;|«Visual LISP© Format Options» (120 2 40 1 T " " 100 9 0 0 0 nil T nil T) ;*** DO NOT add text below the comment! ***|; Hello. If anyone can help , I'm gong crazy cause I can't get it to loop after selecting some points and pressing SPACE I get 'bad argument type: 2D/3D point: nil' and not looping back to where I wrote in lisp... Quote Link to comment Share on other sites More sharing options...
devitg Posted July 31, 2020 Share Posted July 31, 2020 Please upload the sample.dwg where to apply it Quote Link to comment Share on other sites More sharing options...
Tomislav Posted July 31, 2020 Author Share Posted July 31, 2020 1 hour ago, devitg said: Please upload the sample.dwg where to apply it here it is, it's for transferring points from section view to real life coordinates or relative to alignment OS_STAC_i_PROFILI_tutor.dwg 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.