;;;Places demolish (double hatch) or abandon (single hatch) linetype ;;;Requires Linetypes ABAN and DEMOL to be added into ACAD.LIN ;;;Requires shapes ABAN and DEMOL in Ltypeshp.shp compiled into Ltypeshp.shx ;;; ;;;LINETYPE DEFINITIONS: ;;; ;;; ;;;LINETYPE DEFINITIONS: (your system should have the symbol font 'Symeteo' installed) ;;; ;;;*ANSI31,ANSI31 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ;;;A,0,-.15,["U",symeteo,R=0.0,X=-.2,Y=-0.125,S=.3],-.15,0 ;;;*ANSI37, ANSI37 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx ;;;A,0,-.15,["+",symeteo,R=45.0,X=-.1,Y=-0.489,S=.66],-.15,0 ;;; ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. ASHE ST. ;;; SOUTHERN PINES, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; Copyright: 3-5-96 ;;; Edited: 10-21-2002 ;;; (DEFUN c:dmlt (/ pt) (c:svlayr) (IF dimscl nil (LOAD "dimscl") ) ;_ end of if (dimscl) (IF (NOT (TBLOBJNAME "STYLE" "SYMETEO")) (PROGN (SETQ curtxtstyle (GETVAR "textstyle")) (COMMAND "-style" "SYMETEO" "symeteo" 0 1.0 0 "N" "N" "N") (SETVAR "TEXTSTYLE" curtxtstyle) ) ) (SETQ clay_col (CDR (ASSOC 62 (TBLSEARCH "layer" (GETVAR "clayer"))))) (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")) (SETQ colr "1" atyp (ukword 1 "Demolish Abandon" "Demolish or Abandon?" (IF atyp atyp "Demolish" ) ;_ end of if ) ;_ end of ukword modf (SUBSTR atyp 1 4) prod (IF prod prod "UTIL" ) ;_ end of if llt "-" ) ;_ end of setq (c:mklayr) (IF (EQ atyp "Demolish") (PROGN (IF (TBLSEARCH "LTYPE" "ANSI37") NIL (COMMAND "-LINETYPE" "LOAD" "ANSI37" "CUSTOM.LIN" "") ;_ end of COMMAND ) ;_ end of IF (COMMAND "-LAYER" "LT" "ANSI37" "" "") ) (PROGN (IF (TBLSEARCH "LTYPE" "ANSI31") NIL (COMMAND "-LINETYPE" "LOAD" "ANSI31" "CUSTOM.LIN" "") ;_ end of COMMAND ) ;_ end of IF (COMMAND "-LAYER" "LT" "ANSI31" "" "") ) ) ;_ end of IF ;;; (IF (EQ atyp "Demolish") ;;; (IF (TBLSEARCH "LTYPE" "DEMOL") ;;; (COMMAND "-LINETYPE" "SET" "DEMOL" "") ;;; (COMMAND "-LINETYPE" "LOAD" "DEMOL" "ACAD.LIN" "SET" "DEMOL" "") ;_ end of COMMAND ;;; ) ;_ end of IF ;;; (IF (TBLSEARCH "LTYPE" "ABAN") ;;; (COMMAND "-LINETYPE" "SET" "ABAN" "") ;;; (COMMAND "-LINETYPE" "LOAD" "ABAN" "ACAD.LIN" "SET" "ABAN" "") ;_ end of COMMAND ;;; ) ;_ end of IF ;;; ) ;_ end of IF ;;; (PROGN ;;; (SETQ dont_stop T ;;; never_pt T ;;; prev_pt NIL ;;; new_msg NIL ;;; old_msg NIL ;;; seg_type NIL ;;; ) ;_ end of SETQ ;;; (COMMAND ".pline") ;;; (PRINC "\nSpecify start point: ") ;;; (PRINC) ;;; (WHILE ;;; (OR ;;; (AND ;;; (EQ (CAR (SETQ pt (GRREAD T 3 0))) 5) ;;; dont_stop ;;; ) ;_ end of AND ;;; (AND ;;; (EQ (CAR pt) 3) ;;; dont_stop ;;; ) ;_ end of AND ;;; (AND ;;; (EQ (CAR pt) 2) ;;; (EQ (CADR pt) 13) ;;; (OR ;;; never_pt ;;; (EQ (CADR prev_pt) 65) ;;; (EQ (CADR prev_pt) 97) ;;; (EQ (CADR prev_pt) 67) ;;; (EQ (CADR prev_pt) 99) ;;; (EQ (CADR prev_pt) 76) ;;; (EQ (CADR prev_pt) 108) ;;; (EQ (CADR prev_pt) 81) ;;; (EQ (CADR prev_pt) 113) ;;; (EQ (CADR prev_pt) 85) ;;; (EQ (CADR prev_pt) 117) ;;; ) ;_ end of OR ;;; dont_stop ;;; ) ;_ end of AND ;;; (AND ;;; (EQ (CAR pt) 2) ;;; (OR ;;; (EQ (CADR pt) 65) ;;; (EQ (CADR pt) 97) ;;; ) ;_ end of OR ;;; dont_stop ;;; ) ;_ end of AND ;;; (AND ;;; (EQ (CAR pt) 2) ;;; (OR ;;; (EQ (CADR pt) 67) ;;; (EQ (CADR pt) 99) ;;; ) ;_ end of OR ;;; dont_stop ;;; ) ;_ end of AND ;;; (AND ;;; (EQ (CAR pt) 2) ;;; (OR ;;; (EQ (CADR pt) 76) ;;; (EQ (CADR pt) 108) ;;; ) ;_ end of OR ;;; dont_stop ;;; ) ;_ end of AND ;;; (AND ;;; (EQ (CAR pt) 2) ;;; (OR ;;; (EQ (CADR pt) 85) ;;; (EQ (CADR pt) 117) ;;; ) ;_ end of OR ;;; dont_stop ;;; ) ;_ end of AND ;;; (AND ;;; (/= (CAR pt) 2) ;;; (/= (CADR pt) 81) ;;; (/= (CADR pt) 113) ;;; dont_stop ;;; ) ;_ end of AND ;;; ) ;_ end of OR ;;; (COND ;;; ((EQ (CAR pt) 3) ;;; (SETQ never_pt NIL) ;;; (COMMAND (CADR pt)) ;;; ) ;;; ((AND (EQ (CAR pt) 2) ;;; (OR ;;; (EQ (CADR pt) 81) ;;; (EQ (CADR pt) 113) ;;; (EQ (CADR pt) 65) ;;; (EQ (CADR pt) 97) ;;; (EQ (CADR pt) 67) ;;; (EQ (CADR pt) 99) ;;; (EQ (CADR pt) 76) ;;; (EQ (CADR pt) 108) ;;; (EQ (CADR pt) 85) ;;; (EQ (CADR pt) 117) ;;; ) ;_ end of OR ;;; ) ;_ end of AND ;;; (COND ;;; ((EQ (STRCASE (CHR (CADR pt))) "C") ;;; (SETQ dont_stop NIL) ;;; (COMMAND "CL") ;;; ) ;;; ((EQ (STRCASE (CHR (CADR pt))) "Q") ;;; (SETQ dont_stop NIL) ;;; (COMMAND "") ;;; ) ;;; (T (COMMAND (CHR (CADR pt)))) ;;; ) ;_ end of COND ;;; ) ;;; ((AND (EQ (CAR pt) 2) (EQ (CADR pt) 13) never_pt) ;;; (COMMAND (GETVAR"lastpoint")) ;;; (SETQ never_pt NIL)) ;;; ) ;_ end of COND ;;; (IF (OR ;;; (EQ (CADR pt) 67) ;;; (EQ (CADR pt) 99) ;;; (EQ (CADR pt) 81) ;;; (EQ (CADR pt) 113) ;;; ) ;_ end of OR ;;; (PROGN ;;; (SETQ new_msg NIL ;;; old_msg NIL ;;; seg_type NIL ;;; ) ;_ end of SETQ ;;; ) ;_ end of PROGN ;;; ) ;_ end of IF ;;; (COND ;;; ((OR (EQ (CADR pt) 65) (EQ (CADR pt) 97)) ;;; (SETQ seg_type "Arc") ;;; ) ;;; ((OR (EQ (CADR pt) 76) (EQ (CADR pt) 108)) ;;; (SETQ seg_type "Line") ;;; ) ;;; ) ;_ end of COND ;;; (COND ;;; ((EQ seg_type "Arc") ;;; (SETQ new_msg (STRCAT "\nSpecify endpoint of " ;;; seg_type ;;; " or [Line/Undo/Close/Quit]: " ;;; ) ;_ end of STRCAT ;;; ) ;_ end of SETQ ;;; (IF (EQ new_msg old_msg) ;;; NIL ;;; (PROGN (PRINC new_msg) (PRINC)) ;;; ) ;_ end of IF ;;; ) ;;; ((OR (EQ seg_type "Line") (NOT seg_type)) ;;; (SETQ seg_type "Line") ;;; (SETQ new_msg (STRCAT "\nSpecify endpoint of " ;;; seg_type ;;; " or [Arc/Undo/Close/Quit]: " ;;; ) ;_ end of STRCAT ;;; ) ;_ end of SETQ ;;; (IF (EQ new_msg old_msg) ;;; NIL ;;; (PROGN (PRINC new_msg) (PRINC)) ;;; ) ;_ end of IF ;;; ) ;;; ) ;_ end of COND ;;; (SETQ prev_pt pt ;;; old_msg new_msg ;;; ) ;_ end of SETQ ;;; ) ;_ end of while ;;; (PRINC) ;;; ) ;_ end of PROGN ;;; (c:rslayr) ;;; (COMMAND) ;;; (COMMAND "-LINETYPE" "SET" "BYLAYER" "") (COMMAND ".PLINE") (PRINC) ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 2 0 0 T T nil T) ;*** DO NOT add text below the comment! ***|;