(DEFUN c:align3d () (ENTMAKE (LIST (CONS 0 "POLYLINE") (CONS 66 1) (CONS 8 (lay_strcat haln_col_s01)) (CONS 10 (LIST (CAR (NTH 9 (NTH 0 align_lst))) (CADR (NTH 9 (NTH 0 align_lst))) (NTH 2 (NTH 0 align_lst)) ) ;_ end of LIST ) ;_ end of CONS (CONS 40 (IF do_cmud (IF dimsc (* (/ dimsc 40.0) 0.7) 0.7 ) ;_ end of IF 0 ) ;_ end of IF ) ;_ end of CONS (CONS 41 (IF do_cmud (IF dimsc (* (/ dimsc 40.0) 0.7) 0.7 ) ;_ end of IF 0 ) ;_ end of IF ) ;_ end of CONS (CONS 62 (IF do_cmud 3 256 ) ;_ end of IF ) ;_ end of CONS (CONS 70 136) ) ;_ end of LIST ) ;_ end of ENTMAKE (SETQ cnt 0) (WHILE (<= cnt (1- (LENGTH draw_lst))) (ENTMAKE (LIST (CONS 0 "VERTEX") (CONS 8 (lay_strcat haln_col_s01)) (CONS 10 (LIST (CAR (NTH 9 (NTH cnt align_lst))) (CADR (NTH 9 (NTH cnt align_lst))) (NTH 2 (NTH cnt align_lst)) ) ;_ end of LIST ) ;_ end of CONS (CONS 40 (IF do_cmud (IF dimsc (* (/ dimsc 40.0) 0.7) 0.7 ) ;_ end of IF 0 ) ;_ end of IF ) ;_ end of CONS (CONS 41 (IF do_cmud (IF dimsc (* (/ dimsc 40.0) 0.7) 0.7 ) ;_ end of IF 0 ) ;_ end of IF ) ;_ end of CONS (CONS 42 (NTH 11 (NTH cnt draw_lst))) (CONS 62 (IF do_cmud 3 256 ) ;_ end of IF ) ;_ end of CONS (CONS 70 32) ) ;_ end of LIST ) ;_ end of ENTMAKE)) (SETQ cnt (1+ cnt)) ) ;_ end of WHILE (ENTMAKE (LIST (CONS 0 "SEQEND") (CONS 8 (lay_strcat haln_col_s01))) ) ;_ end of ENTMAKE ) ;_ end of defun (DEFUN c:alncirc3d () (SETQ cnt 0) (WHILE (<= cnt (1- (LENGTH draw_lst))) (ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 66 1) (CONS 8 (lay_strcat haln_col_s01)) (CONS 10 (LIST (CAR (NTH 9 (NTH cnt align_lst))) (CADR (NTH 9 (NTH cnt align_lst))) (NTH 2 (NTH cnt align_lst)) ) ;_ end of LIST ) ;_ end of CONS (CONS 40 25.0) ) ;_ end of list ) ;_ end of entmake (SETQ cnt (1+ cnt)) ) ;_ end of while ) ;_ end of DEFUN (DEFUN c:grdcirc3d (/ circ_pnt_lst grd_sta grd_ele cnt circ_pnt assoc_sta_lst sta_loc_lst pnt_cnt grd_pnt grd_sta grd_pnt_back grd_pnt_ahead ) (SETQ cnt 0) (WHILE (<= cnt (1- (LENGTH vsf_lst))) (SETQ grd_sta (CAR (NTH cnt vsf_lst)) grd_ele (CADR (NTH cnt vsf_lst)) ) ;_ end of SETQ (SETQ assoc_sta_lst (MAPCAR 'CDR align_lst)) (SETQ sta_loc_lst (MAPCAR '(LAMBDA (x) (>= (CAR x) grd_sta)) assoc_sta_lst ) ;_ end of MAPCAR ) ;_ end of SETQ (IF (MEMBER T sta_loc_lst) (PROGN (SETQ pnt_cnt (- (LENGTH sta_loc_lst) (LENGTH (MEMBER T sta_loc_lst)) ) ;_ end of - ) ;_ end of SETQ (COND ((EQ pnt_cnt 0) (SETQ grd_pnt (NTH 9 (NTH 0 align_lst))) ) ((EQUAL grd_sta (NTH 1 (NTH pnt_cnt align_lst)) 0.01) (SETQ grd_pnt (NTH 9 (NTH pnt_cnt align_lst))) ) (T (SETQ grd_pnt_back (NTH 9 (NTH (1- pnt_cnt) align_lst))) (SETQ grd_pnt_ahead (NTH 9 (NTH pnt_cnt align_lst))) (SETQ grd_pnt (POLAR grd_pnt_back (ANGLE grd_pnt_back grd_pnt_ahead) (- (NTH 1 (NTH pnt_cnt align_lst)) grd_sta) ) ;_ end of POLAR ) ;_ end of SETQ ) ) ;_ end of COND (SETQ circ_pnt_3d (LIST (CAR grd_pnt) (CADR grd_pnt) grd_ele ) ;_ end of LIST ) ;_ end of SETQ (SETQ circ_pnt_lst (APPEND circ_pnt_lst (LIST circ_pnt_3d))) (SETQ circ_pnt_2d (LIST (CAR grd_pnt) (CADR grd_pnt) ) ;_ end of LIST ) ;_ end of SETQ ;;; (IF (AND prev_circ_pnt_2d ;;; circ_pnt_2d ;;; (< (DISTANCE prev_circ_pnt_2d circ_pnt_2d) 50.0) ;;; ) ;_ end of AND ;;; (PROGN ;;; (PRINC "\nDistance from previous circle = ") ;;; (PRINC (DISTANCE prev_circ_pnt_2d circ_pnt_2d)) ;;; (PRINC) ;;; ) ;_ end of PROGN (PROGN (ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 66 1) (CONS 8 (lay_strcat haln_col_s01)) (CONS 10 circ_pnt_3d) (CONS 40 2.50) ) ;_ end of list ) ;_ end of entmake (SETQ prev_circ_pnt_2d circ_pnt_2d) ) ;_ end of PROGN ;;; ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (SETQ cnt (1+ cnt)) ) ;_ end of while ;;; ;THE LIST OF POINTS IS OUT OF STATION ORDER ;;; ;AND NEEDS TO BE FIXED ;;; (IF circ_pnt_lst ;;; (PROGN ;;; (ENTMAKE (LIST (CONS 0 "POLYLINE") ;;; (CONS 66 1) ;;; (CONS 8 (lay_strcat haln_col_s01)) ;;; (CONS 10 (CAR circ_pnt_lst)) ;;; (CONS 40 ;;; (IF do_cmud ;;; (IF dimsc ;;; (* (/ dimsc 40.0) 0.7) ;;; 0.7 ;;; ) ;_ end of IF ;;; 0 ;;; ) ;_ end of IF ;;; ) ;_ end of CONS ;;; (CONS 41 ;;; (IF do_cmud ;;; (IF dimsc ;;; (* (/ dimsc 40.0) 0.7) ;;; 0.7 ;;; ) ;_ end of IF ;;; 0 ;;; ) ;_ end of IF ;;; ) ;_ end of CONS ;;; (CONS 62 ;;; (IF do_cmud ;;; 3 ;;; 256 ;;; ) ;_ end of IF ;;; ) ;_ end of CONS ;;; (CONS 70 136) ;;; ) ;_ end of LIST ;;; ) ;_ end of ENTMAKE ;;; (SETQ cnt 0) ;;; (WHILE (<= cnt (1- (LENGTH circ_pnt_lst))) ;;; (ENTMAKE ;;; (LIST (CONS 0 "VERTEX") ;;; (CONS 8 (lay_strcat haln_col_s01)) ;;; (CONS 10 (NTH cnt circ_pnt_lst)) ;;; (CONS 62 ;;; (IF do_cmud ;;; 3 ;;; 256 ;;; ) ;_ end of IF ;;; ) ;_ end of CONS ;;; (CONS 70 32) ;;; ) ;_ end of LIST ;;; ) ;_ end of ENTMAKE)) ;;; (SETQ cnt (1+ cnt)) ;;; ) ;_ end of WHILE ;;; (ENTMAKE ;;; (LIST (CONS 0 "SEQEND") (CONS 8 (lay_strcat haln_col_s01))) ;;; ) ;_ end of ENTMAKE ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 1 2 nil T nil T) ;*** DO NOT add text below the comment! ***|;