;;;******************************************************************** (DEFUN symbpoint_error (msg /) (IF oldsymbpt_osmode (SETVAR "osmode" oldsymbpt_osmode) ) ;_ end of IF (SETQ *error* (IF oldsymbpt_error oldsymbpt_error NIL ) ;_ end of IF ) ;_ end of SETQ ;;; (SETQ dact NIL) (PRINC "\n") (PRINC msg) ;;; (princ "\n") ;;; (princ dopt) (TERM_DIALOG) (PRINC) ) ;_ end of DEFUN ;;;******************************************************************** (IF check_for_doslib NIL (LOAD "check_for_doslib" "\nFile CHECK_FOR_DOSLIB.LSP not loaded! ") ) ;_ end of if (check_for_doslib) (VL-ARX-IMPORT 'DOS_SPLITPATH) (VL-ARX-IMPORT 'DOS_MSGBOX) (VL-ARX-IMPORT 'DOS_DIR) (VL-ARX-IMPORT 'DOS_RENAME) (VL-ARX-IMPORT 'DOS_DELETE) (VL-ARX-IMPORT 'DOS_COPY) (VL-ARX-IMPORT 'DOS_COMPACTPATH) (VL-ARX-IMPORT 'DOS_HTMLBOX) ;;;******************************************************************** (DEFUN c:symbpt (/ c3dland labelstyles structlblstyles pipelblstyles );c3dpipe pipedoc ) (IF ukword nil (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ") ) ;_ end of IF (VL-LOAD-COM) (IF c3difodoc nil (LOAD "c3difodoc" "\nFile C3DIFODOC not loaded! ") ) ;_ end of IF (c3difodoc) (SETQ c3dland (VLA-GETINTERFACEOBJECT *acad* (STRCAT "AeccXUiLand.AeccApplication." verstr))) ;make the AECC_COGO_POINT object interface available (SETQ count 0) (SETQ dcapnt (SSGET '((0 . "AECC_COGO_POINT")))) (SETQ sslen (SSLENGTH dcapnt)) (IF dcapnt (SETQ sslen (SSLENGTH dcapnt))) (SETQ symbpnt_ss (SSGET "X" '((0 . "INSERT")(67 . 0)))) ;select all AECC_COGO_POINT objects (SETQ dcapntlst NIL) (WHILE (AND sslen (< count sslen)) (PRINC (STRCAT "\010\010\010\010\010\010\010\010" (ITOA (1+ count)))) (PRINC) (SETQ this_ename (SSNAME dcapnt count) this_entdef (ENTGET this_ename) cogopt (VLAX-ENAME->VLA-OBJECT this_ename) pnt_northing (VLAX-GET-PROPERTY cogopt "Northing") pnt_easting (VLAX-GET-PROPERTY cogopt "Easting") pnt_elevation (VLAX-GET-PROPERTY cogopt "Elevation") pnt_number (VLAX-GET-PROPERTY cogopt "Number") pnt_descript (VLAX-GET-PROPERTY cogopt "FullDescription") ) (SETQ dcapntlst (APPEND dcapntlst (LIST (LIST pnt_number pnt_northing pnt_easting pnt_elevation pnt_descript))) ) (SETQ count (1+ count)) ) ;_ end of while (IF (AND symbpnt_ss dcapntlst) (PROGN (SETQ thispntslist (MAPCAR '(LAMBDA (x) (LIST (CADDR x)(CADDDR x))) dcapntlst)) (SETQ symb_cnt 0) (SETQ fnd_import_file (DOS_GETFILED "Import Points from comma delimited text file" (GETVAR "DWGPREFIX") "Point files (*.txt,*.asc)|*.txt;*.asc|All files (*.*)|*.*||" ) ;_ end of dos_getfiled ) ;_ end of SETQ (IF fnd_import_file (PROGN (SETQ pntsplitpath (DOS_SPLITPATH fnd_import_file)) (SETQ pntfilename (STRCAT (NTH 2 pntsplitpath) (NTH 3 pntsplitpath))) (SETQ last_import_file fnd_import_file) (SETQ open_import (OPEN fnd_import_file "r") import_list NIL sslen 0 ) ;_ end of SETQ (WHILE (SETQ import_line (READ-LINE open_import)) (SETQ import_list (APPEND import_list (LIST import_line))) ;import_list is a straight list generated by appending each read-line (IF (WCMATCH import_line "*`,") ;if no description, add {No Desc...}, subst into the list and increment the no descr counter. (PROGN (SETQ import_list (SUBST (STRCAT import_line "{No Description}") (LAST import_list) import_list ) ;_ end of SUBST ) ;_ end of SETQ (SETQ import_ndpnt (1+ import_ndpnt) ) ;_ end of SETQ ) ;_ end of PROGN ) ;_ end of IF (SETQ sslen (1+ sslen)) ;increment the counter ) ;_ end of WHILE (CLOSE open_import) (SETQ open_import NIL dcastrlst NIL dcacdrlst NIL pointlist NIL ) (SETQ dcacdrlst (MAPCAR 'CDR dcapntlst)) (SETQ dcastrlst (APPEND dcastrlst (MAPCAR '(LAMBDA (y) (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (COND ((EQ (TYPE x) 'STR) (STRCAT x "")) ((EQ (TYPE x) 'INT) (STRCAT (ITOA x) ",")) ((EQ (TYPE x) 'REAL) (STRCAT (RTOS x 2 2) ",")) )) y ) ) ) ) dcacdrlst ) ) ) (IF (AND import_list dcastrlst) (PROGN (SETQ importitmlst (MAPCAR '(LAMBDA (x) (DOS_STRTOKENS x ",")) import_list)) (SETQ importcdrlst (MAPCAR 'CDR importitmlst)) (SETQ importstrlst (APPEND importcdrlst (MAPCAR '(LAMBDA (y) (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (COND ((EQ x (LAST y)) (STRCAT x "")) (T (STRCAT x ",")) ) ) y ) ) ) ) importcdrlst ) ) ) (FOREACH n importstrlst (IF (MEMBER n dcastrlst) NIL (PROGN (SETQ pointlist (APPEND pointlist (LIST n))) ) ) ) (foreach n pointlist (entmake (LIST (CONS 0 "CIRCLE") (CONS 8 "TEST$TE$") (CONS 10 (LIST (ATOF (NTH 1 n))(ATOF (NTH 0 n))(ATOF (NTH 2 n)))) (CONS 40 10.0) ) ) ) ) ) ) ) ;;; (IF importpntlist ;;; (WHILE (< symb_cnt (SSLENGTH symbpnt_ss)) ;;; (SETQ thisent (ENTGET (SSNAME symbpnt_ss symb_cnt))) ;;; (IF ;;; (SETQ thisassoc (ASSOC (LIST (CADR (ASSOC 10 thisent))(CADDR (ASSOC 10 thisent))) importpntlist)) ;;; (PROGN ;;; (SETQ thispoint (ASSOC (LAST thisassoc) importdatalist) ;;; pointlist ;;; (APPEND pointlist ;;; (LIST (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (IF (EQ x (LAST thispoint)) (STRCAT x "") (STRCAT "x" ","))) thispoint)))) ;;; ) ;;; ) ;;; ) ;;; ) ;;; (SETQ symb_cnt (1+ symb_cnt)) ;;; ) ;;; (SETQ pointlist NIL) ;;; ) (IF pointlist (PROGN (SETQ newpntfile (DOS_GETFILENAV "Write New Point File" (STRCAT (GETVAR "DWGPREFIX") "newpoints") "txt" 1 ) ;_ end of dos_getfilenav ) ;_ end of SETQ (SETQ opennewfile (OPEN newpntfile "w")) (FOREACH n pointlist (WRITE-LINE n opennewfile)) (CLOSE opennewfile) ) ) ) ) (PRINC) ) ;;;********************************************************************