;;;***************************************************************************** ;;;3DFACE2LINES creates 3D lines along edges of 3Dfaces ;;;Checks for and will not create duplicate lines. (DEFUN c:3dface2lines () (IF ustr nil (LOAD "ustr" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ uselayer (ustr 1 "Enter Layer of 3DFaces or " (IF uselayer uselayer "Any" ) ;_ end of IF T ) ;_ end of ustr ) ;_ end of SETQ (IF (WCMATCH (STRCASE uselayer) "ANY") (SETQ this_ss (SSGET "x" '((0 . "3DFACE")))) (SETQ this_ss (SSGET "x" (LIST (CONS 8 uselayer) (CONS 0 "3DFACE")))) ) ;_ end of IF (SETQ this_cnt 0 lines_list nil ) ;_ end of SETQ (PRINC "\n") (PRINC (IF this_ss (SSLENGTH this_ss) 0 ) ;_ end of IF ) ;_ end of PRINC (PRINC " 3DFaces were found. ") (PRINC "\n") (WHILE (AND this_ss (< this_cnt (SSLENGTH this_ss))) (SETQ this_ent (ENTGET (SSNAME this_ss this_cnt))) (IF (OR (MEMBER (LIST (CONS 10 (CDR (ASSOC 10 this_ent))) (CONS 11 (CDR (ASSOC 11 this_ent)))) lines_list) (MEMBER (LIST (CONS 10 (CDR (ASSOC 11 this_ent))) (CONS 11 (CDR (ASSOC 10 this_ent)))) lines_list) ) ;_ end of OR nil (PROGN (SETQ lines_list (APPEND lines_list (LIST (LIST (CONS 10 (CDR (ASSOC 10 this_ent))) (CONS 11 (CDR (ASSOC 11 this_ent))))) ) ;_ end of APPEND ) ;_ end of SETQ (ENTMAKE (LIST (CONS 0 "LINE") (CONS 8 "3DLINES") (CONS 10 (CDR (ASSOC 10 this_ent))) (CONS 11 (CDR (ASSOC 11 this_ent))) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of PROGN ) ;_ end of IF (IF (OR (MEMBER (LIST (CONS 10 (CDR (ASSOC 11 this_ent))) (CONS 11 (CDR (ASSOC 12 this_ent)))) lines_list) (MEMBER (LIST (CONS 10 (CDR (ASSOC 12 this_ent))) (CONS 11 (CDR (ASSOC 11 this_ent)))) lines_list) ) ;_ end of OR nil (PROGN (SETQ lines_list (APPEND lines_list (LIST (LIST (CONS 10 (CDR (ASSOC 11 this_ent))) (CONS 11 (CDR (ASSOC 12 this_ent))))) ) ;_ end of APPEND ) ;_ end of SETQ (ENTMAKE (LIST (CONS 0 "LINE") (CONS 8 "3DLINES") (CONS 10 (CDR (ASSOC 11 this_ent))) (CONS 11 (CDR (ASSOC 12 this_ent))) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of PROGN ) ;_ end of IF (IF (OR (MEMBER (LIST (CONS 10 (CDR (ASSOC 12 this_ent))) (CONS 11 (CDR (ASSOC 10 this_ent)))) lines_list) (MEMBER (LIST (CONS 10 (CDR (ASSOC 10 this_ent))) (CONS 11 (CDR (ASSOC 12 this_ent)))) lines_list) ) ;_ end of OR nil (PROGN (SETQ lines_list (APPEND lines_list (LIST (LIST (CONS 10 (CDR (ASSOC 12 this_ent))) (CONS 11 (CDR (ASSOC 10 this_ent))))) ) ;_ end of APPEND ) ;_ end of SETQ (ENTMAKE (LIST (CONS 0 "LINE") (CONS 8 "3DLINES") (CONS 10 (CDR (ASSOC 12 this_ent))) (CONS 11 (CDR (ASSOC 10 this_ent))) ) ;_ end of LIST ) ;_ end of ENTMAKE ) ;_ end of PROGN ) ;_ end of IF (SETQ this_cnt (1+ this_cnt)) (PRINC "\010\010\010\010\010\010") (PRINC this_cnt) (PRINC) ) ;_ end of WHILE (IF (AND this_ss (> (SSLENGTH this_ss) 0)) (PRINC " Done! ") ) ;_ end of IF (PRINC) ) ;_ end of defun ;;;***************************************************************************** ;;;DELZERO deletes near zero length lines ;;;Change the fuzz factor in EQUAL to adjust just how near is near enough. (DEFUN c:delzero () (IF ustr nil (LOAD "ustr" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ uselayer (ustr 1 "Enter Layer of Lines or " (IF uselayer uselayer "Any" ) ;_ end of IF T ) ;_ end of ustr ) ;_ end of SETQ (IF ureal nil (LOAD "ureal" "\nFile UREAL.LSP not loaded! ") ) ;_ end of IF (SETQ fuzz_factor (ureal 1 "" "How close is close enough to equal? " (IF fuzz_factor fuzz_factor 0.05 ) ;_ end of IF ) ;_ end of ureal ) ;_ end of SET (IF (WCMATCH (STRCASE uselayer) "ANY") (SETQ this_ss (SSGET "x" '((0 . "LINE")))) (SETQ this_ss (SSGET "x" (LIST (CONS 8 uselayer) (CONS 0 "LINE")))) ) ;_ end of IF (SETQ this_cnt 0 del_cnt 0 ) (PRINC "\n") (PRINC (IF this_ss (SSLENGTH this_ss) 0 ) ;_ end of IF ) ;_ end of PRINC (PRINC " Lines were found. ") (PRINC "\n") (WHILE (AND this_ss (< this_cnt (SSLENGTH this_ss))) (SETQ this_ent (ENTGET (SSNAME this_ss this_cnt))) (IF (EQUAL (CDR (ASSOC 10 this_ent)) (CDR (ASSOC 11 this_ent)) fuzz_factor) (PROGN (ENTDEL (SSNAME this_ss this_cnt)) (SETQ del_cnt (1+ del_cnt)) ) ) ;_ end of IF (SETQ this_cnt (1+ this_cnt)) (PRINC "\010\010\010\010\010\010\010\010\010") (PRINC this_cnt) (PRINC) ) ;_ end of WHILE (PRINC " Done! ") (PROGN (PRINC "\n") (PRINC del_cnt) (PRINC " near zero length lines were deleted! ") ) (PRINC) ) ;_ end of defun ;;;***************************************************************************** ;;;ENDCOIN forces endpoints of near coincident lines to be exactly coincident ;;;Provide a more specific selection filter for each SSGET to tailor the selection set to your needs (DEFUN c:endcoin ( / done_pt_lst this_ss #10pt #10pt1 #10pt2 #10pt3 #10pt4 #11pt #11pt1 #11pt2 #11pt3 #11pt4 end_ss) (IF ustr nil (LOAD "ustr" "\nFile USTR.LSP not loaded! ") ) ;_ end of IF (SETQ uselayer (ustr 1 "Enter Layer of Lines or " (IF uselayer uselayer "Any" ) ;_ end of IF T ) ;_ end of ustr ) ;_ end of SETQ (IF ureal nil (LOAD "ureal" "\nFile UREAL.LSP not loaded! ") ) ;_ end of IF (SETQ fuzz_factor (ureal 1 "" "How close is close enough to equal? " (IF fuzz_factor fuzz_factor 0.05 ) ;_ end of IF ) ;_ end of ureal ) ;_ end of SET (IF (WCMATCH (STRCASE uselayer) "ANY") (SETQ this_ss (SSGET "x" '((0 . "LINE")))) (SETQ this_ss (SSGET "x" (LIST (CONS 8 uselayer) (CONS 0 "LINE")))) ) ;_ end of IF (SETQ this_cnt 0) (PRINC "\n") (PRINC (IF this_ss (SSLENGTH this_ss) 0 ) ;_ end of IF ) ;_ end of PRINC (PRINC " Lines were found. ") (SETQ this_ss (SSGET "x" '((0 . "LINE")))) (SETQ this_cnt 0) (PRINC "\n") (WHILE (AND this_ss (< this_cnt (SSLENGTH this_ss))) (SETQ this_ent (ENTGET (SSNAME this_ss this_cnt)) #10pt (CDR (ASSOC 10 this_ent)) #10pt1 (POLAR #10pt 0 0.4) #10pt2 (POLAR #10pt (* PI 0.5) 0.4) #10pt3 (POLAR #10pt PI 0.4) #10pt4 (POLAR #10pt (* PI 1.5) 0.4) #11pt (CDR (ASSOC 11 this_ent)) #11pt1 (POLAR #11pt 0 0.4) #11pt2 (POLAR #11pt (* PI 0.5) 0.4) #11pt3 (POLAR #11pt PI 0.4) #11pt4 (POLAR #11pt (* PI 1.5) 0.4) ) ;_ end of SETQ (SETQ end_ss (SSGET "CP" (LIST #10pt1 #10pt2 #10pt3 #10pt4) '((0 . "LINE")))) (IF (AND end_ss (NOT (MEMBER #10pt done_pt_lst))) (PROGN (SETQ end_cnt 0) (WHILE (< end_cnt (SSLENGTH end_ss)) (SETQ this_end_ent (ENTGET (SSNAME end_ss end_cnt))) (IF (OR (EQ (CDR (ASSOC 10 this_end_ent)) #10pt) (EQ (CDR (ASSOC 11 this_end_ent)) #10pt)) nil (COND ((EQUAL (CDR (ASSOC 10 this_end_ent)) #10pt fuzz_factor) (SETQ this_end_ent (SUBST (CONS 10 #10pt) (ASSOC 10 this_end_ent) this_end_ent)) (ENTMOD this_end_ent) ) ((EQUAL (CDR (ASSOC 11 this_end_ent)) #10pt fuzz_factor) (SETQ this_end_ent (SUBST (CONS 11 #10pt) (ASSOC 11 this_end_ent) this_end_ent)) (ENTMOD this_end_ent) ) ) ;_ end of COND ) ;_ end of IF (SETQ end_cnt (1+ end_cnt)) ) ;_ end of WHILE (SETQ done_pt_lst (APPEND done_pt_lst (LIST #10pt))) ) ;_ end of PROGN ) ;_ end of IF (SETQ end_ss (SSGET "CP" (LIST #11pt1 #11pt2 #11pt3 #11pt4) '((0 . "LINE")))) (IF (AND end_ss (NOT (MEMBER #11pt done_pt_lst))) (PROGN (SETQ end_cnt 0) (WHILE (< end_cnt (SSLENGTH end_ss)) (SETQ this_end_ent (ENTGET (SSNAME end_ss end_cnt))) (IF (OR (EQ (CDR (ASSOC 10 this_end_ent)) #11pt) (EQ (CDR (ASSOC 11 this_end_ent)) #11pt)) nil (COND ((EQUAL (CDR (ASSOC 10 this_end_ent)) #11pt fuzz_factor) (SETQ this_end_ent (SUBST (CONS 10 #11pt) (ASSOC 10 this_end_ent) this_end_ent)) (ENTMOD this_end_ent) ) ((EQUAL (CDR (ASSOC 11 this_end_ent)) #11pt fuzz_factor) (SETQ this_end_ent (SUBST (CONS 11 #11pt) (ASSOC 11 this_end_ent) this_end_ent)) (ENTMOD this_end_ent) ) ) ;_ end of COND ) ;_ end of IF (SETQ end_cnt (1+ end_cnt)) ) ;_ end of WHILE (SETQ done_pt_lst (APPEND done_pt_lst (LIST #11pt))) ) ;_ end of PROGN ) ;_ end of IF (SETQ this_cnt (1+ this_cnt)) (PRINC "\010\010\010\010\010\010\010\010\010") (PRINC this_cnt) (PRINC) ) ;_ end of WHILE (PRINC " Done! ") (PRINC) ) ;_ end of defun ;;;***************************************************************************** ;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 1 nil nil nil nil T) ;*** DO NOT add text below the comment! ***|;